Theory SubObj

(*  Title:       CoreC++
    Author:      Daniel Wasserrab
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
*)

section ‹Definition of Subobjects›

theory SubObj
imports ClassRel
begin


subsection ‹General definitions›

type_synonym
  subobj = "cname  × path"

definition mdc :: "subobj ⇒ cname" where
  "mdc S = fst S"

definition ldc :: "subobj ⇒ cname" where
  "ldc S = last (snd S)"


lemma mdc_tuple [simp]: "mdc (C,Cs) = C"
by(simp add:mdc_def)

lemma ldc_tuple [simp]: "ldc (C,Cs) = last Cs"
by(simp add:ldc_def)


subsection ‹Subobjects according to Rossie-Friedman›

fun is_subobj :: "prog ⇒ subobj ⇒ bool" ― ‹legal subobject to class hierarchie› where
  "is_subobj P (C, []) ⟷ False"
| "is_subobj P (C, [D]) ⟷ (is_class P C ∧ C = D) 
                                ∨ (∃ X. P ⊢ C ≼⇧^* X ∧ P ⊢ X ≺⇩_S D)"
| "is_subobj P (C, D # E # Xs) = (let Ys=butlast (D # E # Xs); 
                                      Y=last (D # E # Xs); 
                                      X=last Ys 
                                in is_subobj P (C, Ys) ∧ P ⊢ X ≺⇩_R Y)"

lemma subobj_aux_rev:
assumes 1:"is_subobj P ((C,C'#rev Cs@[C'']))"
shows "is_subobj P ((C,C'#rev Cs))"
proof -
  obtain Cs' where Cs':"Cs' = rev Cs" by simp
  hence rev:"Cs'@[C''] = rev Cs@[C'']" by simp
  from this obtain D Ds where DDs:"Cs'@[C''] = D#Ds" by (cases Cs') auto
  with 1 rev have subo:"is_subobj P ((C,C'#D#Ds))" by simp
  from DDs have "butlast (C'#D#Ds) = C'#Cs'" by (cases Cs') auto
  with subo have "is_subobj P ((C,C'#Cs'))" by simp
  with Cs' show ?thesis by simp
qed



lemma subobj_aux:
assumes 1:"is_subobj P ((C,C'#Cs@[C'']))"
shows "is_subobj P ((C,C'#Cs))"
proof -
  from 1 obtain Cs' where Cs':"Cs' = rev Cs" by simp
  with 1 have "is_subobj P ((C,C'#rev Cs'@[C'']))" by simp
  hence "is_subobj P ((C,C'#rev Cs'))" by (rule subobj_aux_rev)
  with Cs' show ?thesis by simp
qed



lemma isSubobj_isClass:
assumes 1:"is_subobj P (R)"
shows "is_class P (mdc R)"

proof -
  obtain C' Cs' where R:"R = (C',Cs')" by(cases R) auto
  with 1 have ne:"Cs' ≠ []" by (cases Cs') auto
  from this obtain C'' Cs'' where C''Cs'':"Cs' = C''#Cs''" by (cases Cs') auto
  from this obtain Ds where "Ds = rev Cs''" by simp
  with 1 R C''Cs'' have subo1:"is_subobj P ((C',C''#rev Ds))" by simp
  with R show ?thesis
    by (induct Ds,auto simp:mdc_def split:if_split_asm dest:subobj_aux,
      auto elim:converse_rtranclE dest!:subclsS_subcls1 elim:subcls1_class)
qed




lemma isSubobjs_subclsR_rev:
assumes 1:"is_subobj P ((C,Cs@[D,D']@(rev Cs')))"
shows "P ⊢ D ≺⇩_R D'"
using 1
proof (induct Cs')
  case Nil
  from this obtain Cs' X Y Xs where Cs'1:"Cs' = Cs@[D,D']" 
    and "X = hd(Cs@[D,D'])" and "Y = hd(tl(Cs@[D,D']))"
    and "Xs =  tl(tl(Cs@[D,D']))" by simp
  hence Cs'2:"Cs' = X#Y#Xs" by (cases Cs) auto
  from Cs'1 have last:"last Cs' = D'" by simp
  from Cs'1 have butlast:"last(butlast Cs') = D" by (simp add:butlast_tail)
  from Nil Cs'1 Cs'2 have "is_subobj P ((C,X#Y#Xs))" by simp
  with last butlast Cs'2 show ?case by simp
next
  case (Cons C'' Cs'')
  have IH:"is_subobj P ( (C, Cs @ [D, D'] @ rev Cs'')) ⟹ P ⊢ D ≺⇩_R D'" by fact
  from Cons obtain Cs' X Y Xs where Cs'1:"Cs' = Cs@[D,D']@(rev (C''#Cs''))" 
    and "X = hd(Cs@[D,D']@(rev (C''#Cs'')))" 
    and "Y = hd(tl(Cs@[D,D']@(rev (C''#Cs''))))"
    and "Xs =  tl(tl(Cs@[D,D']@(rev (C''#Cs''))))" by simp
  hence Cs'2:"Cs' = X#Y#Xs" by (cases Cs) auto
  from Cons Cs'1 Cs'2 have "is_subobj P ((C,X#Y#Xs))" by simp
  hence sub:"is_subobj P ((C,butlast (X#Y#Xs)))" by simp
  from Cs'1 obtain E Es where Cs'3:"Cs' = Es@[E]" by (cases Cs') auto
  with Cs'1 have butlast:"Es = Cs@[D,D']@(rev Cs'')" by simp
  from Cs'3 have "butlast Cs' = Es" by simp
  with butlast have "butlast Cs' = Cs@[D,D']@(rev Cs'')" by simp
  with Cs'2 sub have "is_subobj P ((C,Cs@[D,D']@(rev Cs'')))"
    by simp
  with IH show ?case by simp
qed



lemma isSubobjs_subclsR:
assumes 1:"is_subobj P ((C,Cs@[D,D']@Cs'))"
shows "P ⊢ D ≺⇩_R D'"

proof -
  from 1 obtain Cs'' where "Cs'' = rev Cs'" by simp
  with 1 have "is_subobj P ((C,Cs@[D,D']@(rev Cs'')))" by simp
  thus ?thesis by (rule isSubobjs_subclsR_rev)
qed




lemma mdc_leq_ldc_aux:
assumes 1:"is_subobj P ((C,C'#rev Cs'))"
shows "P ⊢ C ≼⇧^* last (C'#rev Cs')"
using 1
proof (induct Cs')
  case Nil
  from 1 have "is_class P C"
    by (drule_tac R="(C,C'#rev Cs')" in isSubobj_isClass, simp add:mdc_def)
  with Nil show ?case
    proof (cases "C=C'")
      case True
      thus ?thesis by simp
    next
      case False
      with Nil show ?thesis 
        by (auto dest!:subclsS_subcls1)
    qed
  next
    case (Cons C'' Cs'')
    have IH:"is_subobj P ( (C, C' # rev Cs'')) ⟹ P ⊢ C ≼⇧^* last (C' # rev Cs'')"
      and subo:"is_subobj P ( (C, C' # rev (C'' # Cs'')))" by fact+
    hence "is_subobj P ( (C, C' # rev Cs''))" by (simp add:subobj_aux_rev)
    with IH have rel:"P ⊢ C ≼⇧^* last (C' # rev Cs'')" by simp
    from subo obtain D Ds where DDs:"C' # rev Cs'' = Ds@[D]"
      by (cases Cs'') auto
    hence " C' # rev (C'' # Cs'') = Ds@[D,C'']" by simp
    with subo have "is_subobj P ((C,Ds@[D,C'']))" by (cases Ds) auto
    hence "P ⊢ D ≺⇩_R C''" by (rule_tac Cs'="[]" in isSubobjs_subclsR) simp
    hence rel1:"P ⊢ D ≺⇧¹ C''" by (rule subclsR_subcls1)
    from DDs have "D = last (C' # rev Cs'')" by simp
    with rel1 have lastrel1:"P ⊢ last (C' # rev Cs'') ≺⇧¹ C''" by simp
    with rel have "P ⊢ C ≼⇧^* C''"
      by(rule_tac b="last (C' # rev Cs'')" in rtrancl_into_rtrancl) simp
    thus ?case by simp
qed



lemma mdc_leq_ldc:
assumes 1:"is_subobj P (R)"
shows "P ⊢ mdc R ≼⇧^* ldc R"

proof -
  from 1 obtain C Cs where R:"R = (C,Cs)" by (cases R) auto
  with 1 have ne:"Cs ≠ []" by (cases Cs) auto
  from this obtain C' Cs' where Cs:"Cs = C'#Cs'" by (cases Cs) auto
  from this obtain Cs'' where Cs':"Cs'' = rev Cs'" by simp
  with R Cs 1 have "is_subobj P ((C,C'#rev Cs''))" by simp
  hence rel:"P ⊢ C ≼⇧^* last (C'#rev Cs'')" by (rule mdc_leq_ldc_aux)
  from R Cs Cs' have ldc:"last (C'#rev Cs'') = ldc R" by(simp add:ldc_def)
  from R have "mdc R = C" by(simp add:mdc_def)
  with ldc rel show ?thesis by simp
qed



text‹Next three lemmas show subobject property as presented in literature›

lemma class_isSubobj:
  "is_class P C ⟹ is_subobj P ((C,[C]))"
by simp


lemma repSubobj_isSubobj:
assumes 1:"is_subobj P ((C,Xs@[X]))" and 2:"P ⊢ X ≺⇩_R Y"
shows "is_subobj P ((C,Xs@[X,Y]))"

using 1
proof -
  obtain Cs D E Cs' where Cs1:"Cs = Xs@[X,Y]" and  "D = hd(Xs@[X,Y])"
    and "E = hd(tl(Xs@[X,Y]))" and "Cs' = tl(tl(Xs@[X,Y]))"by simp
  hence Cs2:"Cs = D#E#Cs'" by (cases Xs) auto
  with 1 Cs1 have subobj_butlast:"is_subobj P ((C,butlast(D#E#Cs')))" 
    by (simp add:butlast_tail)
  with 2 Cs1 Cs2 have "P ⊢ (last(butlast(D#E#Cs'))) ≺⇩_R last(D#E#Cs')"
    by (simp add:butlast_tail)
  with subobj_butlast have "is_subobj P ((C,(D#E#Cs')))" by simp
  with Cs1 Cs2 show ?thesis by simp
qed



lemma shSubobj_isSubobj:
assumes 1:  "is_subobj P ((C,Xs@[X]))" and 2:"P ⊢ X ≺⇩_S Y"
shows "is_subobj P ((C,[Y]))"

using 1
proof -
  from 1 have classC:"is_class P C" 
    by (drule_tac R="(C,Xs@[X])" in isSubobj_isClass, simp add:mdc_def)
  from 1 have "P ⊢ C ≼⇧^* X" 
    by (drule_tac R="(C,Xs@[X])" in mdc_leq_ldc, simp add:mdc_def ldc_def)
  with classC 2 show ?thesis by fastforce
qed



text‹Auxiliary lemmas›


lemma build_rec_isSubobj_rev:
assumes 1:"is_subobj P ((D,D#rev Cs))" and 2:" P ⊢ C ≺⇩_R D"
shows "is_subobj P ((C,C#D#rev Cs))"
using 1
proof (induct Cs)
  case Nil
  from 2 have "is_class P C" by (auto dest:subclsRD simp add:is_class_def)
  with 1 2 show ?case by simp
next
  case (Cons C' Cs')
  have suboD:"is_subobj P ((D,D#rev (C'#Cs')))" 
    and IH:"is_subobj P ((D,D#rev Cs')) ⟹ is_subobj P ((C,C#D#rev Cs'))" by fact+
  obtain E Es where E:"E = hd (rev (C'#Cs'))" and Es:"Es = tl (rev (C'#Cs'))"
    by simp
  with E have E_Es:"rev (C'#Cs') = E#Es" by simp
  with E Es have butlast:"butlast (D#E#Es) = D#rev Cs'" by simp
  from E_Es suboD have suboDE:"is_subobj P ((D,D#E#Es))" by simp
  hence "is_subobj P ((D,butlast (D#E#Es)))" by simp
  with butlast have "is_subobj P ((D,D#rev Cs'))" by simp
  with IH have suboCD:"is_subobj P ( (C, C#D#rev Cs'))" by simp
  from suboDE obtain Xs X Y Xs' where Xs':"Xs' = D#E#Es"
    and bb:"Xs = butlast (butlast (D#E#Es))" 
    and lb:"X = last(butlast (D#E#Es))" and l:"Y = last (D#E#Es)" by simp
  from this obtain Xs'' where Xs'':"Xs'' = Xs@[X]" by simp
  with bb lb have "Xs'' = butlast (D#E#Es)" by simp
  with l have "D#E#Es = Xs''@[Y]" by simp
  with Xs'' have "D#E#Es = Xs@[X]@[Y]" by simp
  with suboDE have "is_subobj P ((D,Xs@[X,Y]))" by simp
  hence subR:"P ⊢ X ≺⇩_R Y"  by(rule_tac Cs="Xs" and Cs'="[]" in isSubobjs_subclsR) simp
  from E_Es Es have "last (D#E#Es) = C'" by simp
  with subR lb l butlast have "P ⊢ last(D#rev Cs') ≺⇩_R C'"
    by (auto split:if_split_asm)
  with suboCD show ?case by simp
qed



lemma build_rec_isSubobj:
assumes 1:"is_subobj P ((D,D#Cs))" and 2:" P ⊢ C ≺⇩_R D" 
shows "is_subobj P ((C,C#D#Cs))"

proof -
  obtain Cs' where Cs':"Cs' = rev Cs" by simp
  with 1 have "is_subobj P ((D,D#rev Cs'))" by simp
  with 2 have "is_subobj P ((C,C#D#rev Cs'))" 
    by - (rule build_rec_isSubobj_rev) 
  with Cs' show ?thesis by simp
qed





lemma isSubobj_isSubobj_isSubobj_rev:
assumes 1:"is_subobj P ((C,[D]))" and 2:"is_subobj P ((D,D#(rev Cs)))" 
shows "is_subobj P ((C,D#(rev Cs)))"
using 2
proof (induct Cs)
 case Nil
 with 1 show ?case by simp
next
  case (Cons C' Cs')
  have IH:"is_subobj P ((D,D#rev Cs')) ⟹ is_subobj P ((C,D#rev Cs'))"
    and "is_subobj P ((D,D#rev (C'#Cs')))" by fact+
  hence suboD:"is_subobj P ((D,D#rev Cs'@[C']))" by simp
  hence "is_subobj P ((D,D#rev Cs'))" by (rule subobj_aux_rev)
  with IH have suboC:"is_subobj P ((C,D#rev Cs'))" by simp
  obtain C'' where C'': "C'' = last (D # rev Cs')" by simp
  moreover have "D # rev Cs' = butlast (D # rev Cs') @ [last (D # rev Cs')]"
    by (rule append_butlast_last_id [symmetric]) simp
  ultimately have butlast: "D # rev Cs' = butlast (D  #rev Cs') @ [C'']"
    by simp
  hence butlast2:"D#rev Cs'@[C'] = butlast(D#rev Cs')@[C'']@[C']" by simp
  with suboD have "is_subobj P ((D,butlast(D#rev Cs')@[C'']@[C']))"
    by simp
  with C'' have subR:"P ⊢ C'' ≺⇩_R C'"
    by (rule_tac Cs="butlast(D#rev Cs')" and Cs'="[]" in isSubobjs_subclsR)simp
  with C'' suboC butlast have "is_subobj P ((C,butlast(D#rev Cs')@[C'']@[C']))"
    by (auto intro:repSubobj_isSubobj simp del:butlast.simps)
  with butlast2 have "is_subobj P ((C,D#rev Cs'@[C']))"
    by (cases Cs')auto
  thus ?case by simp
qed


lemma isSubobj_isSubobj_isSubobj:
assumes 1:"is_subobj P ((C,[D]))" and 2:"is_subobj P ((D,D#Cs))" 
shows "is_subobj P ((C,D#Cs))"

proof -
  obtain Cs' where Cs':"Cs' = rev Cs" by simp
  with 2 have "is_subobj P ((D,D#rev Cs'))" by simp
  with 1 have "is_subobj P ((C,D#rev Cs'))"
  by - (rule isSubobj_isSubobj_isSubobj_rev)
with Cs' show ?thesis by simp
qed



subsection ‹Subobject handling and lemmas›

text‹Subobjects consisting of repeated inheritance relations only:›

inductive Subobjs⇩_R :: "prog ⇒ cname ⇒ path ⇒ bool" for P :: prog
where
  SubobjsR_Base: "is_class P C ⟹ Subobjs⇩_R P C [C]"
| SubobjsR_Rep: "⟦P ⊢ C ≺⇩_R D; Subobjs⇩_R P D Cs⟧ ⟹ Subobjs⇩_R P C (C # Cs)"

text‹All subobjects:›

inductive Subobjs :: "prog ⇒ cname ⇒ path ⇒ bool" for P :: prog
where
  Subobjs_Rep: "Subobjs⇩_R P C Cs ⟹ Subobjs P C Cs"
| Subobjs_Sh: "⟦P ⊢ C ≼⇧^* C'; P ⊢ C' ≺⇩_S D; Subobjs⇩_R P D Cs⟧
             ⟹ Subobjs P C Cs"


lemma Subobjs_Base:"is_class P C ⟹ Subobjs P C [C]"
by (fastforce intro:Subobjs_Rep SubobjsR_Base)

lemma SubobjsR_nonempty: "Subobjs⇩_R P C Cs ⟹ Cs ≠ []"
by (induct rule: Subobjs⇩_R.induct, simp_all)

lemma Subobjs_nonempty: "Subobjs P C Cs ⟹ Cs ≠ []"
by (erule Subobjs.induct)(erule SubobjsR_nonempty)+


lemma hd_SubobjsR:
  "Subobjs⇩_R P C Cs ⟹ ∃Cs'. Cs = C#Cs'"
by(erule Subobjs⇩_R.induct,simp+)


lemma SubobjsR_subclassRep: 
  "Subobjs⇩_R P C Cs ⟹ (C,last Cs) ∈ (subclsR P)⇧^*"

apply(erule Subobjs⇩_R.induct)
 apply simp
apply(simp add: SubobjsR_nonempty)
done


lemma SubobjsR_subclass: "Subobjs⇩_R P C Cs ⟹ P ⊢ C ≼⇧^* last Cs"

apply(erule Subobjs⇩_R.induct)
 apply simp
apply(simp add: SubobjsR_nonempty)
apply(blast intro:subclsR_subcls1 rtrancl_trans)
done


lemma Subobjs_subclass: "Subobjs P C Cs ⟹ P ⊢ C ≼⇧^* last Cs"

apply(erule Subobjs.induct)
 apply(erule SubobjsR_subclass)
apply(erule rtrancl_trans)
apply(blast intro:subclsS_subcls1 SubobjsR_subclass rtrancl_trans)
done




lemma Subobjs_notSubobjsR:
  "⟦Subobjs P C Cs; ¬ Subobjs⇩_R P C Cs⟧
⟹ ∃C' D. P ⊢ C ≼⇧^* C' ∧ P ⊢ C' ≺⇩_S D ∧ Subobjs⇩_R P D Cs"
apply (induct rule: Subobjs.induct)
 apply clarsimp
apply fastforce
done



lemma assumes subo:"Subobjs⇩_R P (hd (Cs@ C'#Cs')) (Cs@ C'#Cs')"
  shows SubobjsR_Subobjs:"Subobjs P C' (C'#Cs')"
  using subo
proof (induct Cs)
  case Nil
  thus ?case by -(frule hd_SubobjsR,fastforce intro:Subobjs_Rep)
next
  case (Cons D Ds)
  have subo':"Subobjs⇩_R P (hd ((D#Ds) @ C'#Cs')) ((D#Ds) @ C'#Cs')"
    and IH:"Subobjs⇩_R P (hd (Ds @ C'#Cs')) (Ds @ C'#Cs') ⟹ Subobjs P C' (C'#Cs')" by fact+
  from subo' have "Subobjs⇩_R P (hd (Ds @ C' # Cs')) (Ds @ C' # Cs')"
    apply -
    apply (drule Subobjs⇩_R.cases)
    apply auto
    apply (rename_tac D')
    apply (subgoal_tac "D' = hd (Ds @ C' # Cs')")
    apply (auto dest:hd_SubobjsR)
    done
  with IH show ?case by simp
qed

lemma Subobjs_Subobjs:"Subobjs P C (Cs@ C'#Cs') ⟹ Subobjs P C' (C'#Cs')"
  
  apply -
  apply (drule Subobjs.cases)
  apply auto
   apply (subgoal_tac "C = hd(Cs @ C' # Cs')")
    apply (fastforce intro:SubobjsR_Subobjs)
   apply (fastforce dest:hd_SubobjsR)
  apply (subgoal_tac "D = hd(Cs @ C' # Cs')")
   apply (fastforce intro:SubobjsR_Subobjs)
  apply (fastforce dest:hd_SubobjsR)
  done
  


lemma SubobjsR_isClass:
assumes subo:"Subobjs⇩_R P C Cs"
shows "is_class P C"

using subo
proof (induct rule:Subobjs⇩_R.induct)
  case SubobjsR_Base thus ?case by assumption
next
  case SubobjsR_Rep thus ?case by (fastforce intro:subclsR_subcls1 subcls1_class)
qed


lemma Subobjs_isClass:
assumes subo:"Subobjs P C Cs"
shows "is_class P C"

using subo
proof (induct rule:Subobjs.induct)
  case Subobjs_Rep thus ?case by (rule SubobjsR_isClass)
next
  case (Subobjs_Sh C C' D Cs)
  have leq:"P ⊢ C ≼⇧^* C'" and leqS:"P ⊢ C' ≺⇩_S D" by fact+
  hence "(C,D) ∈ (subcls1 P)⇧⁺" by (fastforce intro:rtrancl_into_trancl1 subclsS_subcls1)
  thus ?case by (induct rule:trancl_induct, fastforce intro:subcls1_class)
qed


lemma Subobjs_subclsR:
assumes subo:"Subobjs P C (Cs@[D,D']@Cs')"
shows "P ⊢ D ≺⇩_R D'"

using subo
proof -
  from subo have "Subobjs P D (D#D'#Cs')" by -(rule Subobjs_Subobjs,simp)
  then obtain C' where subo':"Subobjs⇩_R P C' (D#D'#Cs')"
    by (induct rule:Subobjs.induct,blast+)
  hence "C' = D" by -(drule hd_SubobjsR,simp)
  with subo' have "Subobjs⇩_R P D (D#D'#Cs')" by simp
  thus ?thesis by (fastforce elim:Subobjs⇩_R.cases dest:hd_SubobjsR)
qed




lemma assumes subo:"Subobjs⇩_R P (hd Cs) (Cs@[D])" and notempty:"Cs ≠ []"
  shows butlast_Subobjs_Rep:"Subobjs⇩_R P (hd Cs) Cs"
using subo notempty
proof (induct Cs)
  case Nil thus ?case by simp
next
  case (Cons C' Cs')
  have subo:"Subobjs⇩_R P (hd(C'#Cs')) ((C'#Cs')@[D])"
    and IH:"⟦Subobjs⇩_R P (hd Cs') (Cs'@[D]); Cs' ≠ []⟧ ⟹ Subobjs⇩_R P (hd Cs') Cs'" by fact+
  from subo have subo':"Subobjs⇩_R P C' (C'#Cs'@[D])" by simp
  show ?case
  proof (cases "Cs' = []")
    case True
    with subo' have "Subobjs⇩_R P C' [C',D]" by simp
    hence "is_class P C'" by(rule SubobjsR_isClass)
    hence "Subobjs⇩_R P C' [C']" by (rule SubobjsR_Base)
    with True show ?thesis by simp
  next
    case False
    with subo' obtain D' where subo'':"Subobjs⇩_R P D' (Cs'@[D])"
      and subR:"P ⊢ C' ≺⇩_R D'"
      by (auto elim:Subobjs⇩_R.cases)
    from False subo'' have hd:"D' = hd Cs'"
      by (induct Cs',auto dest:hd_SubobjsR)
    with subo'' False IH have "Subobjs⇩_R P (hd Cs') Cs'" by simp 
    with subR hd have "Subobjs⇩_R P C' (C'#Cs')" by (fastforce intro:SubobjsR_Rep)
    thus ?thesis by simp
  qed
qed



lemma assumes subo:"Subobjs P C (Cs@[D])" and notempty:"Cs ≠ []"
  shows butlast_Subobjs:"Subobjs P C Cs"

using subo
proof (rule Subobjs.cases,auto)
  assume suboR:"Subobjs⇩_R P C (Cs@[D])" and "Subobjs P C (Cs@[D])"
  from suboR notempty have hd:"C = hd Cs"
    by (induct Cs,auto dest:hd_SubobjsR)
  with suboR notempty have "Subobjs⇩_R P (hd Cs) Cs"
    by(fastforce intro:butlast_Subobjs_Rep)
  with hd show "Subobjs P C Cs" by (fastforce intro:Subobjs_Rep)
next
  fix C' D' assume leq:"P ⊢ C ≼⇧^* C'" and subS:"P ⊢ C' ≺⇩_S D'"
  and suboR:"Subobjs⇩_R P D' (Cs@[D])" and "Subobjs P C (Cs@[D])"
  from suboR notempty have hd:"D' = hd Cs"
    by (induct Cs,auto dest:hd_SubobjsR)
  with suboR notempty have "Subobjs⇩_R P (hd Cs) Cs"
    by(fastforce intro:butlast_Subobjs_Rep)
  with hd leq subS show "Subobjs P C Cs"
    by(fastforce intro:Subobjs_Sh)
qed




lemma assumes subo:"Subobjs P C (Cs@(rev Cs'))" and notempty:"Cs ≠ []"
  shows rev_appendSubobj:"Subobjs P C Cs"
using subo
proof(induct Cs')
  case Nil thus ?case by simp
next
  case (Cons D Ds)
  have subo':"Subobjs P C (Cs@rev(D#Ds))"
    and IH:"Subobjs P C (Cs@rev Ds) ⟹ Subobjs P C Cs" by fact+
  from notempty subo' have "Subobjs P C (Cs@rev Ds)"
    by (fastforce intro:butlast_Subobjs)
  with IH show ?case by simp
qed



lemma appendSubobj:
assumes subo:"Subobjs P C (Cs@Cs')" and notempty:"Cs ≠ []"
shows "Subobjs P C Cs"

proof -
  obtain Cs'' where Cs'':"Cs'' = rev Cs'" by simp
  with subo have "Subobjs P C (Cs@(rev Cs''))" by simp
  with notempty show ?thesis by - (rule rev_appendSubobj)
qed




lemma SubobjsR_isSubobj:
  "Subobjs⇩_R P C Cs ⟹ is_subobj P ((C,Cs))"
by(erule Subobjs⇩_R.induct,simp,
  auto dest:hd_SubobjsR intro:build_rec_isSubobj)

lemma leq_SubobjsR_isSubobj:
  "⟦P ⊢ C ≼⇧^* C'; P ⊢ C' ≺⇩_S D; Subobjs⇩_R P D Cs⟧ 
⟹ is_subobj P ((C,Cs))"

apply (subgoal_tac "is_subobj P ((C,[D]))")
 apply (frule hd_SubobjsR)
 apply (drule SubobjsR_isSubobj)
 apply (erule exE)
 apply (simp del: is_subobj.simps)
 apply (erule isSubobj_isSubobj_isSubobj)
 apply simp
apply auto
done


lemma Subobjs_isSubobj:
  "Subobjs P C Cs ⟹ is_subobj P ((C,Cs))"
by (auto elim:Subobjs.induct SubobjsR_isSubobj 
  simp add:leq_SubobjsR_isSubobj)



subsection ‹Paths›


subsection ‹Appending paths›

text‹Avoided name clash by calling one path Path.›

definition path_via :: "prog ⇒ cname ⇒ cname ⇒ path ⇒ bool" ("_ ⊢ Path _ to _ via _ " [51,51,51,51] 50) where
  "P ⊢ Path C to D via Cs ≡ Subobjs P C Cs ∧ last Cs = D"

definition path_unique :: "prog ⇒ cname ⇒ cname ⇒ bool" ("_ ⊢ Path _ to _ unique" [51,51,51] 50) where
  "P ⊢ Path C to D unique ≡ ∃!Cs. Subobjs P C Cs ∧ last Cs = D"

definition appendPath :: "path ⇒ path ⇒ path" (infixr "@⇩_p" 65) where
  "Cs @⇩_p Cs' ≡ if (last Cs = hd Cs') then Cs @ (tl Cs') else Cs'"


lemma appendPath_last: "Cs ≠ [] ⟹ last Cs = last (Cs'@⇩_pCs)"
by(auto simp:appendPath_def last_append)(cases Cs, simp_all)+



inductive
  casts_to :: "prog ⇒ ty ⇒ val ⇒ val ⇒ bool"
    ("_ ⊢ _ casts _ to _ " [51,51,51,51] 50)
  for P :: prog
where

  casts_prim: "∀C. T ≠ Class C ⟹ P ⊢ T casts v to v"

| casts_null: "P ⊢ Class C casts Null to Null"

| casts_ref: "⟦ P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩_pCs' ⟧
  ⟹ P ⊢ Class C casts Ref(a,Cs) to Ref(a,Ds)"


inductive
  Casts_to :: "prog ⇒ ty list ⇒ val list ⇒ val list ⇒ bool"
    ("_ ⊢ _ Casts _ to _ " [51,51,51,51] 50)
  for P :: prog
where

  Casts_Nil: "P ⊢ [] Casts [] to []"

| Casts_Cons: "⟦ P ⊢ T casts v to v'; P ⊢ Ts Casts vs to vs' ⟧
  ⟹ P ⊢ (T#Ts) Casts (v#vs) to (v'#vs')"



lemma length_Casts_vs:
  "P ⊢ Ts Casts vs to vs' ⟹ length Ts = length vs"
by (induct rule:Casts_to.induct,simp_all)

lemma length_Casts_vs':
  "P ⊢ Ts Casts vs to vs' ⟹ length Ts = length vs'"
by (induct rule:Casts_to.induct,simp_all)



subsection ‹The relation on paths›

inductive_set
  leq_path1 :: "prog ⇒ cname ⇒ (path × path) set"
  and leq_path1' :: "prog ⇒ cname ⇒ [path, path] ⇒ bool" ("_,_ ⊢ _ ⊏⇧¹ _" [71,71,71] 70)
  for P :: prog and C :: cname
where
  "P,C ⊢ Cs ⊏⇧¹ Ds ≡ (Cs,Ds) ∈ leq_path1 P C"
| leq_pathRep: "⟦ Subobjs P C Cs; Subobjs P C Ds; Cs = butlast Ds⟧
  ⟹ P,C ⊢ Cs ⊏⇧¹ Ds"
| leq_pathSh:  "⟦ Subobjs P C Cs; P ⊢ last Cs ≺⇩_S D ⟧
  ⟹ P,C ⊢ Cs ⊏⇧¹ [D]"

abbreviation
  leq_path :: "prog ⇒ cname ⇒ [path, path] ⇒ bool" ("_,_ ⊢ _ ⊑ _"  [71,71,71] 70) where
  "P,C ⊢ Cs ⊑ Ds ≡ (Cs,Ds) ∈ (leq_path1 P C)⇧^*"


lemma leq_path_rep:
  "⟦ Subobjs P C (Cs@[C']); Subobjs P C (Cs@[C',C''])⟧ 
⟹ P,C ⊢ (Cs@[C']) ⊏⇧¹ (Cs@[C',C''])"
by(rule leq_pathRep,simp_all add:butlast_tail)

lemma leq_path_sh:
  "⟦ Subobjs P C (Cs@[C']); P ⊢ C' ≺⇩_S C''⟧ 
⟹ P,C ⊢ (Cs@[C']) ⊏⇧¹ [C'']"
by(erule leq_pathSh)simp




subsection‹Member lookups›

definition FieldDecls :: "prog ⇒ cname ⇒ vname ⇒ (path × ty) set" where
  "FieldDecls P C F ≡ 
   {(Cs,T). Subobjs P C Cs ∧ (∃Bs fs ms. class P (last Cs) = Some(Bs,fs,ms)
                                    ∧ map_of fs F = Some T)}"

definition LeastFieldDecl  :: "prog ⇒ cname ⇒ vname ⇒ ty ⇒ path ⇒ bool"
    ("_ ⊢ _ has least _:_ via _" [51,0,0,0,51] 50) where
  "P ⊢ C has least F:T via Cs ≡
   (Cs,T) ∈ FieldDecls P C F ∧
   (∀(Cs',T') ∈ FieldDecls P C F. P,C ⊢ Cs ⊑ Cs')"

definition MethodDefs :: "prog ⇒ cname ⇒ mname ⇒ (path × method)set" where
  "MethodDefs P C M ≡
   {(Cs,mthd). Subobjs P C Cs ∧ (∃Bs fs ms. class P (last Cs) = Some(Bs,fs,ms)
                                    ∧ map_of ms M = Some mthd)}"

  ― ‹needed for well formed criterion›
definition HasMethodDef :: "prog ⇒ cname ⇒ mname ⇒ method ⇒ path ⇒ bool"
    ("_ ⊢ _ has _ = _ via _" [51,0,0,0,51] 50) where
  "P ⊢ C has M = mthd via Cs ≡ (Cs,mthd) ∈ MethodDefs P C M"

definition LeastMethodDef :: "prog ⇒ cname ⇒ mname ⇒ method ⇒ path ⇒ bool"
    ("_ ⊢ _ has least _ = _ via _" [51,0,0,0,51] 50) where
  "P ⊢ C has least M = mthd via Cs ≡
   (Cs,mthd) ∈ MethodDefs P C M ∧
   (∀(Cs',mthd') ∈ MethodDefs P C M. P,C ⊢ Cs ⊑ Cs')"

definition MinimalMethodDefs :: "prog ⇒ cname ⇒ mname ⇒ (path × method)set" where
  "MinimalMethodDefs P C M ≡ 
      {(Cs,mthd). (Cs,mthd) ∈ MethodDefs P C M ∧ 
         (∀(Cs',mthd')∈ MethodDefs P C M. P,C ⊢ Cs' ⊑ Cs ⟶ Cs' = Cs)}"

definition OverriderMethodDefs :: "prog ⇒ subobj ⇒ mname ⇒ (path × method)set" where
  "OverriderMethodDefs P R M ≡
      {(Cs,mthd). ∃Cs' mthd'. P ⊢ (ldc R) has least M = mthd' via Cs' ∧
                      (Cs,mthd) ∈ MinimalMethodDefs P (mdc R) M ∧ 
                      P,mdc R ⊢ Cs ⊑ (snd R)@⇩_pCs'}"

definition FinalOverriderMethodDef :: "prog ⇒ subobj ⇒ mname ⇒ method ⇒ path ⇒ bool"
    ("_ ⊢ _ has overrider _ = _ via _" [51,0,0,0,51] 50) where
  "P ⊢ R has overrider M = mthd via Cs ≡ 
      (Cs,mthd) ∈ OverriderMethodDefs P R M ∧ 
      card(OverriderMethodDefs P R M) = 1"
      (*(∀(Cs',mthd') ∈ OverriderMethodDefs P R M. Cs = Cs' ∧ mthd = mthd')"*)


inductive
  SelectMethodDef :: "prog ⇒ cname ⇒ path ⇒ mname ⇒ method ⇒ path ⇒ bool"
     ("_ ⊢ '(_,_') selects _ = _ via _" [51,0,0,0,0,51] 50)
  for P :: prog
where

  dyn_unique:
    "P ⊢ C has least M = mthd via Cs' ⟹ P ⊢ (C,Cs) selects M = mthd via Cs'"

| dyn_ambiguous:
    "⟦∀mthd Cs'. ¬ P ⊢ C has least M = mthd via Cs'; 
      P ⊢ (C,Cs) has overrider M = mthd via Cs'⟧
  ⟹ P ⊢ (C,Cs) selects M = mthd via Cs'"



lemma sees_fields_fun:
  "(Cs,T) ∈ FieldDecls P C F ⟹ (Cs,T') ∈ FieldDecls P C F ⟹ T = T'"
by(fastforce simp:FieldDecls_def)

lemma sees_field_fun:
  "⟦P ⊢ C has least F:T via Cs; P ⊢ C has least F:T' via Cs⟧
  ⟹ T = T'"
by (fastforce simp:LeastFieldDecl_def dest:sees_fields_fun)


lemma has_least_method_has_method:
  "P ⊢ C has least M = mthd via Cs ⟹ P ⊢ C has M = mthd via Cs"
by (simp add:LeastMethodDef_def HasMethodDef_def)


lemma visible_methods_exist:
  "(Cs,mthd) ∈ MethodDefs P C M ⟹
  (∃Bs fs ms. class P (last Cs) = Some(Bs,fs,ms) ∧ map_of ms M = Some mthd)"
by(auto simp:MethodDefs_def)


lemma sees_methods_fun:
  "(Cs,mthd) ∈ MethodDefs P C M ⟹ (Cs,mthd') ∈ MethodDefs P C M ⟹ mthd = mthd'"
by(fastforce simp:MethodDefs_def)

lemma sees_method_fun:
  "⟦P ⊢ C has least M = mthd via Cs; P ⊢ C has least M = mthd' via Cs⟧
  ⟹ mthd = mthd'"
by (fastforce simp:LeastMethodDef_def dest:sees_methods_fun)


lemma overrider_method_fun:
assumes overrider:"P ⊢ (C,Cs) has overrider M = mthd via Cs'"
  and overrider':"P ⊢ (C,Cs) has overrider M = mthd' via Cs''"
shows "mthd = mthd' ∧ Cs' = Cs''"
proof -
  from overrider' have omd:"(Cs'',mthd') ∈ OverriderMethodDefs P (C,Cs) M"
    by(simp_all add:FinalOverriderMethodDef_def)
  from overrider have "(Cs',mthd) ∈ OverriderMethodDefs P (C,Cs) M"
    and "card(OverriderMethodDefs P (C,Cs) M) = 1" 
    by(simp_all add:FinalOverriderMethodDef_def)
  hence "∀(Ds,mthd'') ∈ OverriderMethodDefs P (C,Cs) M. (Cs',mthd) = (Ds,mthd'')"
    by(fastforce simp:card_Suc_eq)
  with omd show ?thesis by fastforce
qed


end

Theory WellForm

(*  Title:       CoreC++
    Author:      Daniel Wasserrab
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>

    Based on the Jinja theory Common/WellForm.thy by Tobias Nipkow 
*)

section ‹Generic Well-formedness of programs›

theory WellForm
imports SystemClasses TypeRel WellType
begin


text ‹\noindent This theory defines global well-formedness conditions
for programs but does not look inside method bodies. Well-typing of 
expressions is defined elsewhere (in theory ‹WellType›). 

CoreC++ allows covariant return types›


type_synonym wf_mdecl_test = "prog ⇒ cname ⇒ mdecl ⇒ bool"

definition wf_fdecl :: "prog ⇒ fdecl ⇒ bool" where
  "wf_fdecl P ≡ λ(F,T). is_type P T"

definition wf_mdecl :: "wf_mdecl_test ⇒ wf_mdecl_test" where
  "wf_mdecl wf_md P C ≡ λ(M,Ts,T,mb).
  (∀T∈set Ts. is_type P T) ∧ is_type P T ∧ T ≠ NT ∧ wf_md P C (M,Ts,T,mb)"

definition wf_cdecl :: "wf_mdecl_test ⇒ prog ⇒ cdecl ⇒ bool" where
  "wf_cdecl wf_md P  ≡  λ(C,(Bs,fs,ms)).
  (∀M mthd Cs. P ⊢ C has M = mthd via Cs ⟶ 
               (∃mthd' Cs'. P ⊢ (C,Cs) has overrider M = mthd' via Cs')) ∧ 
  (∀f∈set fs. wf_fdecl P f) ∧  distinct_fst fs ∧
  (∀m∈set ms. wf_mdecl wf_md P C m) ∧  distinct_fst ms ∧
  (∀D ∈ baseClasses Bs.
   is_class P D ∧ ¬ P ⊢ D ≼⇧^* C ∧
   (∀(M,Ts,T,m)∈set ms.
      ∀Ts' T' m' Cs. P ⊢ D has M = (Ts',T',m') via Cs ⟶
                     Ts' = Ts ∧ P ⊢ T ≤ T'))"

definition wf_syscls :: "prog ⇒ bool" where
  "wf_syscls P  ≡  sys_xcpts ⊆ set(map fst P)"

definition wf_prog :: "wf_mdecl_test ⇒ prog ⇒ bool" where
  "wf_prog wf_md P ≡ wf_syscls P ∧ distinct_fst P ∧ 
                     (∀c ∈ set P. wf_cdecl wf_md P c)"



subsection‹Well-formedness lemmas›

lemma class_wf: 
  "⟦class P C = Some c; wf_prog wf_md P⟧ ⟹ wf_cdecl wf_md P (C,c)"

apply (unfold wf_prog_def class_def)
apply (fast dest: map_of_SomeD)
done



lemma is_class_xcpt:
  "⟦ C ∈ sys_xcpts; wf_prog wf_md P ⟧ ⟹ is_class P C"

  apply (simp add: wf_prog_def wf_syscls_def is_class_def class_def)
  apply (fastforce intro!: map_of_SomeI)
  done



lemma is_type_pTs:
assumes "wf_prog wf_md P" and "(C,S,fs,ms) ∈ set P" and "(M,Ts,T,m) ∈ set ms"
shows "set Ts ⊆ types P"
proof
  from assms have "wf_mdecl wf_md P C (M,Ts,T,m)"
    by (unfold wf_prog_def wf_cdecl_def) auto
  hence "∀t ∈ set Ts. is_type P t" by (unfold wf_mdecl_def) auto
  moreover fix t assume "t ∈ set Ts"
  ultimately have "is_type P t" by blast
  thus "t ∈ types P" ..
qed



subsection‹Well-formedness subclass lemmas›

lemma subcls1_wfD:
  "⟦ P ⊢ C ≺⇧¹ D; wf_prog wf_md P ⟧ ⟹ D ≠ C ∧ (D,C) ∉ (subcls1 P)⇧⁺"

apply( frule r_into_trancl)
apply( drule subcls1D)
apply(clarify)
apply( drule (1) class_wf)
apply( unfold wf_cdecl_def baseClasses_def)
apply(force simp add: reflcl_trancl [THEN sym] simp del: reflcl_trancl)
done



lemma wf_cdecl_supD: 
  "⟦wf_cdecl wf_md P (C,Bs,r); D ∈ baseClasses Bs⟧ ⟹ is_class P D"
by (auto simp: wf_cdecl_def baseClasses_def)


lemma subcls_asym:
  "⟦ wf_prog wf_md P; (C,D) ∈ (subcls1 P)⇧⁺ ⟧ ⟹ (D,C) ∉ (subcls1 P)⇧⁺"

apply(erule trancl.cases)
apply(fast dest!: subcls1_wfD )
apply(fast dest!: subcls1_wfD intro: trancl_trans)
done



lemma subcls_irrefl:
  "⟦ wf_prog wf_md P; (C,D) ∈ (subcls1 P)⇧⁺ ⟧ ⟹ C ≠ D"

apply (erule trancl_trans_induct)
apply  (auto dest: subcls1_wfD subcls_asym)
done



lemma subcls_asym2:
  "⟦ (C,D) ∈ (subcls1 P)⇧^*; wf_prog wf_md P; (D,C) ∈ (subcls1 P)⇧^* ⟧ ⟹ C = D"

apply (induct rule:rtrancl.induct)
apply simp
apply (drule rtrancl_into_trancl1)
apply simp
apply (drule subcls_asym)
apply simp
apply(drule rtranclD)
apply simp
done



lemma acyclic_subcls1:
  "wf_prog wf_md P ⟹ acyclic (subcls1 P)"

apply (unfold acyclic_def)
apply (fast dest: subcls_irrefl)
done



lemma wf_subcls1:
  "wf_prog wf_md P ⟹ wf ((subcls1 P)¯)"

apply (rule finite_acyclic_wf_converse)
apply (rule finite_subcls1)
apply (erule acyclic_subcls1)
done



lemma subcls_induct: 
  "⟦ wf_prog wf_md P; ⋀C. ∀D. (C,D) ∈ (subcls1 P)⇧⁺ ⟶ Q D ⟹ Q C ⟧ ⟹ Q C"

  (is "?A ⟹ PROP ?P ⟹ _")

proof -
  assume p: "PROP ?P"
  assume ?A thus ?thesis apply -
apply(drule wf_subcls1)
apply(drule wf_trancl)
apply(simp only: trancl_converse)
apply(erule_tac a = C in wf_induct)
apply(rule p)
apply(auto)
done
qed




subsection‹Well-formedness leq\_path lemmas›

lemma last_leq_path:
assumes leq:"P,C ⊢ Cs ⊏⇧¹ Ds" and wf:"wf_prog wf_md P"
shows "P ⊢ last Cs ≺⇧¹ last Ds"

using leq
proof (induct rule:leq_path1.induct)
  fix Cs Ds assume suboCs:"Subobjs P C Cs" and suboDs:"Subobjs P C Ds"
  and butlast:"Cs = butlast Ds"
  from suboDs have notempty:"Ds ≠ []" by -(drule Subobjs_nonempty)
  with butlast have DsCs:"Ds = Cs @ [last Ds]" by simp
  from suboCs have notempty:"Cs ≠ []" by -(drule Subobjs_nonempty)
  with DsCs have "Ds = ((butlast Cs) @ [last Cs]) @ [last Ds]" by simp
  with suboDs have "Subobjs P C ((butlast Cs) @ [last Cs,last Ds])"
    by simp
  thus "P ⊢ last Cs ≺⇧¹ last Ds" by (fastforce intro:subclsR_subcls1 Subobjs_subclsR)
next
  fix Cs D assume "P ⊢ last Cs ≺⇩_S D"
  thus "P ⊢ last Cs ≺⇧¹ last [D]" by (fastforce intro:subclsS_subcls1)
qed



lemma last_leq_paths:
assumes leq:"(Cs,Ds) ∈ (leq_path1 P C)⇧⁺" and wf:"wf_prog wf_md P"
shows "(last Cs,last Ds) ∈ (subcls1 P)⇧⁺"

using leq
proof (induct rule:trancl.induct)
  fix Cs Ds assume "P,C ⊢ Cs ⊏⇧¹ Ds"
  thus "(last Cs, last Ds) ∈ (subcls1 P)⇧⁺" using wf
    by (fastforce intro:r_into_trancl elim:last_leq_path)
next
  fix Cs Cs' Ds assume "(last Cs, last Cs') ∈ (subcls1 P)⇧⁺"
    and "P,C ⊢ Cs' ⊏⇧¹ Ds"
  thus "(last Cs, last Ds) ∈ (subcls1 P)⇧⁺" using wf
    by (fastforce dest:last_leq_path)
qed



lemma leq_path1_wfD:
"⟦ P,C ⊢ Cs ⊏⇧¹ Cs'; wf_prog wf_md P ⟧ ⟹ Cs ≠ Cs' ∧ (Cs',Cs) ∉ (leq_path1 P C)⇧⁺"

apply (rule conjI)
 apply (erule leq_path1.cases) 
  apply simp
  apply (drule_tac Cs="Ds" in Subobjs_nonempty)
  apply (rule butlast_noteq) apply assumption
 apply clarsimp
 apply (drule subclsS_subcls1)
 apply (drule subcls1_wfD) apply simp_all
apply clarsimp
apply (frule last_leq_path)
 apply simp
apply (drule last_leq_paths)
 apply simp
apply (drule_tac r="subcls1 P" in r_into_trancl)
apply (drule subcls_asym) 
apply auto
done



lemma leq_path_asym:
"⟦(Cs,Cs') ∈ (leq_path1 P C)⇧⁺; wf_prog wf_md P⟧ ⟹ (Cs',Cs) ∉ (leq_path1 P C)⇧⁺"

apply(erule tranclE)
apply(fast dest!:leq_path1_wfD )
apply(fast dest!:leq_path1_wfD intro: trancl_trans)
done



lemma leq_path_asym2:"⟦P,C ⊢ Cs ⊑ Cs'; P,C ⊢ Cs' ⊑ Cs; wf_prog wf_md P⟧ ⟹ Cs = Cs'"

apply (induct rule:rtrancl.induct)
 apply simp
apply (drule rtrancl_into_trancl1)
 apply simp
apply (drule leq_path_asym)
 apply simp
apply (drule_tac a="c" and b="a" in rtranclD)
apply simp
done



lemma leq_path_Subobjs:
"⟦P,C ⊢ [C] ⊑ Cs; is_class P C; wf_prog wf_md P⟧ ⟹ Subobjs P C Cs"
by (induct rule:rtrancl_induct,auto intro:Subobjs_Base elim!:leq_path1.cases,
         auto dest!:Subobjs_subclass intro!:Subobjs_Sh SubobjsR_Base dest!:subclsSD
              intro:wf_cdecl_supD class_wf ShBaseclass_isBaseclass subclsSI)




subsection‹Lemmas concerning Subobjs›

lemma Subobj_last_isClass:"⟦wf_prog wf_md P; Subobjs P C Cs⟧ ⟹ is_class P (last Cs)"

apply (frule Subobjs_isClass)
apply (drule Subobjs_subclass)
apply (drule rtranclD)
apply (erule disjE)
 apply simp
apply clarsimp
apply (erule trancl_induct)
 apply (fastforce dest:subcls1D class_wf elim:wf_cdecl_supD)
apply (fastforce dest:subcls1D class_wf elim:wf_cdecl_supD)
done



lemma converse_SubobjsR_Rep:
  "⟦Subobjs⇩_R P C Cs; P ⊢ last Cs ≺⇩_R C'; wf_prog wf_md P⟧ 
⟹ Subobjs⇩_R P C (Cs@[C'])"

apply (induct rule:Subobjs⇩_R.induct)
 apply (frule subclsR_subcls1)
 apply (fastforce dest!:subcls1D class_wf wf_cdecl_supD SubobjsR_Base SubobjsR_Rep)
apply (fastforce elim:SubobjsR_Rep simp: SubobjsR_nonempty split:if_split_asm)
done



lemma converse_Subobjs_Rep:
  "⟦Subobjs P C Cs; P ⊢ last Cs ≺⇩_R C';  wf_prog wf_md P⟧ 
⟹ Subobjs P C (Cs@[C'])"
by (induct rule:Subobjs.induct, fastforce dest:converse_SubobjsR_Rep Subobjs_Rep, 
  fastforce dest:converse_SubobjsR_Rep Subobjs_Sh)



lemma isSubobj_Subobjs_rev:
assumes subo:"is_subobj P ((C,C'#rev Cs'))" and wf:"wf_prog wf_md P"
shows "Subobjs P C (C'#rev Cs')"
using subo
proof (induct Cs')
  case Nil
  show ?case
  proof (cases "C=C'")
    case True
    have "is_subobj P ((C,C'#rev []))" by fact
    with True have "is_subobj P ((C,[C]))" by simp
    hence "is_class P C"
      by (fastforce elim:converse_rtranclE dest:subclsS_subcls1 elim:subcls1_class)
    with True show ?thesis by (fastforce intro:Subobjs_Base)
  next
    case False
    have "is_subobj P ((C,C'#rev []))" by fact
    with False obtain D where sup:"P ⊢ C ≼⇧^* D" and subS:"P ⊢ D ≺⇩_S C'"
      by fastforce
    with wf have "is_class P C'"
      by (fastforce dest:subclsS_subcls1 subcls1D class_wf elim:wf_cdecl_supD)
    hence "Subobjs⇩_R P C' [C']" by (fastforce elim:SubobjsR_Base)
    with sup subS have "Subobjs P C [C']" by -(erule Subobjs_Sh, simp)
    thus ?thesis by simp
  qed 
next 
  case (Cons C'' Cs'')
  have IH:"is_subobj P ((C,C'#rev Cs'')) ⟹ Subobjs P C (C'#rev Cs'')"
    and subo:"is_subobj P ((C,C'#rev(C''# Cs'')))" by fact+
  obtain Ds' where Ds':"Ds' = rev Cs''" by simp
  obtain D Ds where DDs:"D#Ds = Ds'@[C'']" by (cases Ds') auto
  with Ds' subo have "is_subobj P ((C,C'#D#Ds))" by simp
  hence subobl:"is_subobj P ((C,butlast(C'#D#Ds)))" 
    and subRbl:"P ⊢ last(butlast(C'#D#Ds)) ≺⇩_R last(C'#D#Ds)" by simp+
  with DDs Ds' have "is_subobj P ((C,C'#rev Cs''))" by (simp del: is_subobj.simps)
  with IH have suborev:"Subobjs P C (C'#rev Cs'')" by simp
  from subRbl DDs Ds' have subR:"P ⊢ last(C'#rev Cs'') ≺⇩_R C''" by simp
  with suborev wf show ?case by (fastforce dest:converse_Subobjs_Rep)
qed



lemma isSubobj_Subobjs:
assumes subo:"is_subobj P ((C,Cs))" and wf:"wf_prog wf_md P"
shows "Subobjs P C Cs"

using subo
proof (induct Cs)
  case Nil
  thus ?case by simp
next
  case (Cons C' Cs')
  have subo:"is_subobj P ((C,C'#Cs'))" by fact
  obtain Cs'' where Cs'':"Cs'' = rev Cs'" by simp
  with subo have "is_subobj P ((C,C'#rev Cs''))" by simp
  with wf have "Subobjs P C (C'#rev Cs'')" by - (rule isSubobj_Subobjs_rev)
  with Cs'' show ?case by simp
qed



lemma isSubobj_eq_Subobjs:
  "wf_prog wf_md P ⟹ is_subobj P ((C,Cs)) = (Subobjs P C Cs)"
by(auto elim:isSubobj_Subobjs Subobjs_isSubobj)



lemma subo_trans_subcls:
  assumes subo:"Subobjs P C (Cs@ C'#rev Cs')"
  shows "∀C'' ∈ set Cs'. (C',C'') ∈ (subcls1 P)⇧⁺"

using subo
proof (induct Cs')
  case Nil
  thus ?case by simp
next
  case (Cons D Ds)
  have IH:"Subobjs P C (Cs @ C' # rev Ds) ⟹
           ∀C''∈set Ds. (C', C'') ∈ (subcls1 P)⇧⁺"
    and "Subobjs P C (Cs @ C' # rev (D # Ds))" by fact+
  hence subo':"Subobjs P C (Cs@ C'#rev Ds @ [D])" by simp
  hence "Subobjs P C (Cs@ C'#rev Ds)"
    by -(rule appendSubobj,simp_all)
  with IH have set:"∀C''∈set Ds. (C', C'') ∈ (subcls1 P)⇧⁺" by simp
  hence revset:"∀C''∈set (rev Ds). (C', C'') ∈ (subcls1 P)⇧⁺" by simp
  have "(C',D) ∈ (subcls1 P)⇧⁺"
  proof (cases "Ds = []")
    case True
    with subo' have "Subobjs P C (Cs@[C',D])" by simp
    thus ?thesis
      by (fastforce intro: subclsR_subcls1 Subobjs_subclsR)
  next
    case False
    with revset have hd:"(C',hd Ds) ∈ (subcls1 P)⇧⁺"
      apply -
      apply (erule ballE)
       apply simp
      apply (simp add:in_set_conv_decomp)
      apply (erule_tac x="[]" in allE)
      apply (erule_tac x="tl Ds" in allE)
      apply simp
      done
    from False subo' have "(hd Ds,D) ∈ (subcls1 P)⇧⁺"
      apply (cases Ds)
       apply simp
      apply simp
      apply (rule r_into_trancl)
      apply (rule subclsR_subcls1)
      apply (rule_tac Cs="Cs @ C' # rev list" in Subobjs_subclsR)
      apply simp
      done
    with hd show ?thesis by (rule trancl_trans)
  qed
  with set show ?case by simp
qed



lemma unique1:
  assumes subo:"Subobjs P C (Cs@ C'#Cs')" and wf:"wf_prog wf_md P"
  shows "C' ∉ set Cs'"

proof -
  obtain Ds where Ds:"Ds = rev Cs'" by simp
  with subo have "Subobjs P C (Cs@ C'#rev Ds)" by simp
  with Ds subo have "∀C'' ∈ set Cs'. (C',C'') ∈ (subcls1 P)⇧⁺"
    by (fastforce dest:subo_trans_subcls)
  with wf have "∀C'' ∈ set Cs'. C' ≠ C''"
    by (auto dest:subcls_irrefl)
  thus ?thesis by fastforce
qed



lemma subo_subcls_trans:
  assumes subo:"Subobjs P C (Cs@ C'#Cs')"
  shows "∀C'' ∈ set Cs. (C'',C') ∈ (subcls1 P)⇧⁺"

proof -
  from wf subo have "⋀C''. C'' ∈ set Cs ⟹ (C'',C') ∈ (subcls1 P)⇧⁺"
    apply (auto simp:in_set_conv_decomp)
    apply (case_tac zs)
     apply (fastforce intro: subclsR_subcls1 Subobjs_subclsR)
    apply simp
    apply (rule_tac b="a" in trancl_rtrancl_trancl)
     apply (fastforce intro: subclsR_subcls1 Subobjs_subclsR)
    apply (subgoal_tac "P ⊢ a ≼⇧^* last (a # list @ [C'])")
     apply simp
    apply (rule Subobjs_subclass)
    apply (rule_tac C="C" and Cs=" ys @[C'']" in Subobjs_Subobjs)
    apply (rule_tac Cs'="Cs'" in appendSubobj)
    apply simp_all
    done
  thus ?thesis by fastforce
qed



lemma unique2:
  assumes subo:"Subobjs P C (Cs@ C'#Cs')" and wf:"wf_prog wf_md P"
  shows "C' ∉ set Cs"

proof -
  from subo wf have "∀C'' ∈ set Cs. (C'',C') ∈ (subcls1 P)⇧⁺"
    by (fastforce dest:subo_subcls_trans)
  with wf have "∀C'' ∈ set Cs. C' ≠ C''"
    by (auto dest:subcls_irrefl)
  thus ?thesis by fastforce
qed




lemma mdc_hd_path:
assumes subo:"Subobjs P C Cs" and set:"C ∈ set Cs" and wf:"wf_prog wf_md P"
shows "C = hd Cs"

proof -
  from subo set obtain Ds Ds' where Cs:"Cs = Ds@ C#Ds'"
    by (auto simp:in_set_conv_decomp)
  then obtain Cs' where Cs':"Cs' = rev Ds" by simp
  with Cs subo have subo':"Subobjs P C ((rev Cs')@ C#Ds')" by simp
  thus ?thesis
  proof (cases Cs')
    case Nil
    with Cs Cs' show ?thesis by simp
  next
    case (Cons X Xs)
    with subo' have suboX:"Subobjs P C ((rev Xs)@[X,C]@Ds')" by simp
    hence leq:"P ⊢ X ≺⇧¹ C"
      by (fastforce intro:subclsR_subcls1 Subobjs_subclsR)
    from suboX wf have "P ⊢ C ≼⇧^* last ((rev Xs)@[X])"
      by (fastforce intro:Subobjs_subclass appendSubobj)
    with leq have "(C,C) ∈ (subcls1 P)⇧⁺" by simp
    with wf show ?thesis by (fastforce dest:subcls_irrefl)
  qed
qed



lemma mdc_eq_last:
  assumes subo:"Subobjs P C Cs" and last:"last Cs = C" and wf:"wf_prog wf_md P"
shows "Cs = [C]"

proof -
  from subo have notempty:"Cs ≠ []" by - (drule Subobjs_nonempty)
  hence lastset:"last Cs ∈ set Cs"
    apply (auto simp add:in_set_conv_decomp)
    apply (rule_tac x="butlast Cs" in exI)
    apply (rule_tac x="[]" in exI)
    apply simp
    done
  with last have C:"C ∈ set Cs" by simp
  with subo wf have hd:"C = hd Cs" by -(rule mdc_hd_path)
  then obtain Cs' where Cs':"Cs' = tl Cs" by simp
  thus ?thesis
  proof (cases Cs')
    case Nil
    with hd subo Cs' show ?thesis by (fastforce dest:Subobjs_nonempty hd_Cons_tl)
  next
    case (Cons D Ds)
    with Cs' hd notempty have Cs:"Cs=C#D#Ds" by simp
    with subo have "Subobjs P C (C#D#Ds)" by simp
    with wf have notset:"C ∉ set (D#Ds)" by -(rule_tac Cs="[]" in unique1,simp_all)
    from Cs last have "last Cs = last (D#Ds)" by simp
    hence "last Cs ∈ set (D#Ds)"
      apply (auto simp add:in_set_conv_decomp)
      apply (erule_tac x="butlast Ds" in allE)
      apply (erule_tac x="[]" in allE)
      apply simp
      done
    with last have "C ∈ set (D#Ds)" by simp
    with notset show ?thesis by simp
  qed
qed



lemma assumes leq:"P ⊢ C ≼⇧^* D" and wf:"wf_prog wf_md P"
  shows subcls_leq_path:"∃Cs. P,C ⊢ [C] ⊑ Cs@[D]"

using leq
proof (induct rule:rtrancl.induct)
  fix C show "∃Cs. P,C ⊢ [C] ⊑ Cs@[C]" by (rule_tac x="[]" in exI,simp)
next
  fix C C' D assume leq':"P ⊢ C ≼⇧^* C'" and IH:"∃Cs. P,C ⊢ [C] ⊑ Cs@[C']"
    and sub:"P ⊢ C' ≺⇧¹ D"
  from sub have "is_class P C'" by (rule subcls1_class)
  with leq' have "class": "is_class P C" by (rule subcls_is_class)
  from IH obtain Cs where steps:"P,C ⊢ [C] ⊑ Cs@[C']" by auto
  hence subo:"Subobjs P C (Cs@[C'])" using "class" wf 
    by (fastforce intro:leq_path_Subobjs)
  { assume "P ⊢ C' ≺⇩_R D"
    with subo wf have "Subobjs P C (Cs@[C',D])"
      by (fastforce dest:converse_Subobjs_Rep)
    with subo have "P,C ⊢ (Cs@[C']) ⊏⇧¹ (Cs@[C']@[D])"
      by (fastforce intro:leq_path_rep) }
  moreover 
  { assume "P ⊢ C' ≺⇩_S D"
    with subo have "P,C ⊢ (Cs@[C']) ⊏⇧¹ [D]" by (rule leq_path_sh) }
  ultimately show "∃Cs. P,C ⊢ [C] ⊑ Cs@[D]" using sub steps
    apply (auto dest!:subcls1_subclsR_or_subclsS)
    apply (rule_tac x="Cs@[C']" in exI) apply simp
    apply (rule_tac x="[]" in exI) apply simp
    done
qed

    


lemma assumes subo:"Subobjs P C (rev Cs)" and wf:"wf_prog wf_md P"
  shows subobjs_rel_rev:"P,C ⊢ [C] ⊑ (rev Cs)"
using subo
proof (induct Cs)
  case Nil
  thus ?case by (fastforce dest:Subobjs_nonempty)
next
  case (Cons C' Cs')
  have subo':"Subobjs P C (rev (C'#Cs'))"
    and IH:"Subobjs P C (rev Cs') ⟹ P,C ⊢ [C] ⊑ rev Cs'" by fact+
  from subo' have "class": "is_class P C" by(rule Subobjs_isClass)
  show ?case
  proof (cases "Cs' = []")
    case True hence empty:"Cs' = []" .
    with subo' have subo'':"Subobjs P C [C']" by simp
    thus ?thesis
    proof (cases "C = C'")
      case True
      with empty show ?thesis by simp
    next
      case False
      with subo'' obtain D D' where leq:"P ⊢ C ≼⇧^* D" and subS:"P ⊢ D ≺⇩_S D'"
        and suboR:"Subobjs⇩_R P D' [C']"
        by (auto elim:Subobjs.cases dest:hd_SubobjsR)
      from suboR have C':"C' = D'" by (fastforce dest:hd_SubobjsR)
      from leq wf obtain Ds where steps:"P,C ⊢ [C] ⊑ Ds@[D]"
        by (auto dest:subcls_leq_path)
      hence suboSteps:"Subobjs P C (Ds@[D])" using "class" wf
        apply (induct rule:rtrancl_induct)
         apply (erule Subobjs_Base)
        apply (auto elim!:leq_path1.cases)
        apply (subgoal_tac "Subobjs⇩_R P D [D]")
         apply (fastforce dest:Subobjs_subclass intro:Subobjs_Sh)
        apply (fastforce dest!:subclsSD intro:SubobjsR_Base wf_cdecl_supD 
                                             class_wf ShBaseclass_isBaseclass)
        done
      hence step:"P,C ⊢ (Ds@[D]) ⊏⇧¹ [D']" using subS by (rule leq_path_sh)
      with steps empty False C' show ?thesis by simp
    qed
  next
    case False
    with subo' have subo'':"Subobjs P C (rev Cs')"
      by (fastforce intro:butlast_Subobjs)
    with IH have steps:"P,C ⊢ [C] ⊑ rev Cs'" by simp
    from subo' subo'' have "P,C ⊢ rev Cs' ⊏⇧¹ rev (C'#Cs')"
      by (fastforce intro:leq_pathRep)
    with steps show ?thesis by simp
  qed
qed



lemma subobjs_rel:
assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
shows "P,C ⊢ [C] ⊑ Cs"

proof -
  obtain Cs' where Cs':"Cs' = rev Cs" by simp
  with subo have "Subobjs P C (rev Cs')" by simp
  hence "P,C ⊢ [C] ⊑ rev Cs'" using wf by (rule subobjs_rel_rev)
  with Cs' show ?thesis by simp
qed



lemma assumes wf:"wf_prog wf_md P"
  shows leq_path_last:"⟦P,C ⊢ Cs ⊑ Cs'; last Cs = last Cs'⟧ ⟹ Cs = Cs'"

proof(induct rule:rtrancl_induct)
  show "Cs = Cs" by simp
next
  fix Cs' Cs''
  assume leqs:"P,C ⊢ Cs ⊑ Cs'" and leq:"P,C ⊢ Cs' ⊏⇧¹ Cs''"
    and last:"last Cs = last Cs''"
    and IH:"last Cs = last Cs' ⟹ Cs = Cs'"
  from leq wf have sup1:"P ⊢ last Cs' ≺⇧¹ last Cs''"
    by(rule last_leq_path)
  { assume "Cs = Cs'"
    with last have eq:"last Cs'' = last Cs'" by simp
    with eq wf sup1 have "Cs = Cs''" by(fastforce dest:subcls1_wfD) }
  moreover
  { assume "(Cs,Cs') ∈ (leq_path1 P C)⇧⁺"
    hence sub:"(last Cs,last Cs') ∈ (subcls1 P)⇧⁺" using wf
      by(rule last_leq_paths)
    with sup1 last have "(last Cs'',last Cs'') ∈ (subcls1 P)⇧⁺" by simp
    with wf have "Cs = Cs''" by(fastforce dest:subcls_irrefl) }
  ultimately show "Cs = Cs''" using leqs
    by(fastforce dest:rtranclD)
qed

 


subsection‹Well-formedness and appendPath›


lemma appendPath1:
  "⟦Subobjs P C Cs; Subobjs P (last Cs) Ds; last Cs ≠ hd Ds⟧
⟹ Subobjs P C Ds"

apply(subgoal_tac "¬ Subobjs⇩_R P (last Cs) Ds")
 apply (subgoal_tac "∃C' D. P ⊢ last Cs ≼⇧^* C' ∧ P ⊢ C' ≺⇩_S D ∧ Subobjs⇩_R P D Ds")
  apply clarsimp
  apply (drule Subobjs_subclass)
  apply (subgoal_tac "P ⊢ C ≼⇧^* C'")
   apply (erule_tac C'="C'" and D="D" in Subobjs_Sh)
    apply simp
   apply simp
  apply fastforce
 apply (erule Subobjs_notSubobjsR)
 apply simp
apply (fastforce dest:hd_SubobjsR)
done
 



lemma appendPath2_rev:
assumes subo1:"Subobjs P C Cs" and subo2:"Subobjs P (last Cs) (last Cs#rev Ds)"
  and wf:"wf_prog wf_md P"
shows "Subobjs P C (Cs@(tl (last Cs#rev Ds)))"
using subo2
proof (induct Ds)
  case Nil
  with subo1 show ?case by simp
next
  case (Cons D' Ds')
  have IH:"Subobjs P (last Cs) (last Cs#rev Ds')
    ⟹ Subobjs P C (Cs@tl(last Cs#rev Ds'))"
    and subo:"Subobjs P (last Cs) (last Cs#rev (D'#Ds'))" by fact+
  from subo have "Subobjs P (last Cs) (last Cs#rev Ds')"
    by (fastforce intro:butlast_Subobjs)
  with IH have subo':"Subobjs P C (Cs@tl(last Cs#rev Ds'))"
    by simp
  have last:"last(last Cs#rev Ds') = last (Cs@tl(last Cs#rev Ds'))"
    by (cases Ds')auto
  obtain C' Cs' where C':"C' = last(last Cs#rev Ds')" and
    "Cs' = butlast(last Cs#rev Ds')" by simp
  then have "Cs' @ [C'] = last Cs # rev Ds'"
    using append_butlast_last_id by blast
  hence "last Cs#rev (D'#Ds') = Cs'@[C',D']" by simp
  with subo have "Subobjs P (last Cs) (Cs'@[C',D'])" by (cases Cs') auto
  hence "P ⊢ C' ≺⇩_R D'" by - (rule Subobjs_subclsR,simp)
  with C' last have "P ⊢ last (Cs@tl(last Cs#rev Ds')) ≺⇩_R D'" by simp
  with subo' wf have "Subobjs P C ((Cs@tl(last Cs#rev Ds'))@[D'])"
    by (erule_tac Cs="(Cs@tl(last Cs#rev Ds'))" in converse_Subobjs_Rep) simp
  thus ?case by simp
qed



lemma appendPath2:
assumes subo1:"Subobjs P C Cs" and subo2:"Subobjs P (last Cs) Ds" 
  and eq:"last Cs = hd Ds" and wf:"wf_prog wf_md P"
shows "Subobjs P C (Cs@(tl Ds))"

using subo2
proof (cases Ds)
  case Nil
  with subo1 show ?thesis by simp
next
  case (Cons D' Ds')
  with subo2 eq have subo:"Subobjs P (last Cs) (last Cs#Ds')" by simp
  obtain Ds'' where Ds'':"Ds'' = rev Ds'" by simp
  with subo have "Subobjs P (last Cs) (last Cs#rev Ds'')" by simp
  with subo1 wf have "Subobjs P C (Cs@(tl (last Cs#rev Ds'')))"
    by -(rule appendPath2_rev)
  with Ds'' eq Cons show ?thesis by simp
qed



lemma Subobjs_appendPath:
  "⟦Subobjs P C Cs; Subobjs P (last Cs) Ds;wf_prog wf_md P⟧
⟹ Subobjs P C (Cs@⇩_pDs)"
by(fastforce elim:appendPath2 appendPath1 simp:appendPath_def)


subsection‹Path and program size›

lemma assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
  shows path_contains_classes:"∀C' ∈ set Cs. is_class P C'"
using subo

proof clarsimp
  fix C' assume subo:"Subobjs P C Cs" and set:"C' ∈ set Cs"
  from set obtain Ds Ds' where Cs:"Cs = Ds@C'#Ds'"
    by (fastforce simp:in_set_conv_decomp)
  with Cs show "is_class P C'"
  proof (cases "Ds = []")
    case True
    with Cs subo have subo':"Subobjs P C (C'#Ds')" by simp
    thus ?thesis by (rule Subobjs.cases,
      auto dest:hd_SubobjsR intro:SubobjsR_isClass)
  next
    case False
    then obtain C'' Cs'' where Cs'':"Cs'' = butlast Ds"
      and last:"C'' = last Ds" by auto
    with False have Ds:"Ds = Cs''@[C'']" by simp
    with Cs subo have subo':"Subobjs P C (Cs''@[C'',C']@Ds')"
      by simp
    hence "P ⊢ C'' ≺⇩_R C'" by(fastforce intro:isSubobjs_subclsR Subobjs_isSubobj)
    with wf show ?thesis
      by (fastforce dest!:subclsRD
                   intro:wf_cdecl_supD class_wf RepBaseclass_isBaseclass subclsSI)
  qed
qed


lemma path_subset_classes:"⟦Subobjs P C Cs; wf_prog wf_md P⟧ 
  ⟹ set Cs ⊆ {C. is_class P C}"
by (auto dest:path_contains_classes)


lemma assumes subo:"Subobjs P C (rev Cs)" and wf:"wf_prog wf_md P"
  shows rev_path_distinct_classes:"distinct Cs"
  using subo
proof (induct Cs)
  case Nil thus ?case by(fastforce dest:Subobjs_nonempty)
next
  case (Cons C' Cs')
  have subo':"Subobjs P C (rev(C'#Cs'))"
    and IH:"Subobjs P C (rev Cs') ⟹ distinct Cs'" by fact+
  show ?case
  proof (cases "Cs' = []")
    case True thus ?thesis by simp
  next
    case False
    hence rev:"rev Cs' ≠ []" by simp
    from subo' have subo'':"Subobjs P C (rev Cs'@[C'])" by simp
    hence "Subobjs P C (rev Cs')" using rev wf
      by(fastforce dest:appendSubobj)
    with IH have dist:"distinct Cs'" by simp
    from subo'' wf have "C' ∉ set (rev Cs')"
      by(fastforce dest:unique2)
    with dist show ?thesis by simp
  qed
qed


lemma assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
  shows path_distinct_classes:"distinct Cs"

proof -
  obtain Cs' where Cs':"Cs' = rev Cs" by simp
  with subo have "Subobjs P C (rev Cs')" by simp
  with wf have "distinct Cs'"
    by -(rule rev_path_distinct_classes)
  with Cs' show ?thesis by simp
qed



lemma assumes wf:"wf_prog wf_md P" 
  shows prog_length:"length P = card {C. is_class P C}"

proof -
  from wf have dist_fst:"distinct_fst P" by (simp add:wf_prog_def)
  hence "distinct P" by (simp add:distinct_fst_def,induct P,auto)
  hence card_set:"card (set P) = length P" by (rule distinct_card)
  from dist_fst have set:"{C. is_class P C} = fst ` (set P)"
    by (simp add:is_class_def class_def,auto simp:distinct_fst_def,
      auto dest:map_of_eq_Some_iff intro!:image_eqI)
  from dist_fst have "card(fst ` (set P)) = card (set P)"
    by(auto intro:card_image simp:distinct_map distinct_fst_def)
  with card_set set show ?thesis by simp
qed




lemma assumes subo:"Subobjs P C Cs" and wf:"wf_prog wf_md P"
  shows path_length:"length Cs ≤ length P"

proof -
  from subo wf have "distinct Cs" by (rule path_distinct_classes)
  hence card_eq_length:"card (set Cs) = length Cs" by (rule distinct_card)
  from subo wf have "card (set Cs) ≤ card {C. is_class P C}"
    by (auto dest:path_subset_classes intro:card_mono finite_is_class)
  with card_eq_length have "length Cs ≤ card {C. is_class P C}" by simp
  with wf show ?thesis by(fastforce dest:prog_length)
qed



lemma empty_path_empty_set:"{Cs. Subobjs P C Cs ∧ length Cs ≤ 0} = {}" 
by (auto dest:Subobjs_nonempty)

lemma split_set_path_length:"{Cs. Subobjs P C Cs ∧ length Cs ≤ Suc(n)} = 
{Cs. Subobjs P C Cs ∧ length Cs ≤ n} ∪ {Cs. Subobjs P C Cs ∧ length Cs = Suc(n)}"
by auto

lemma empty_list_set:"{xs. set xs ⊆ F ∧ xs = []} = {[]}"
by auto

lemma suc_n_union_of_union:"{xs. set xs ⊆ F ∧ length xs = Suc n} = (UN x:F. UN xs : {xs. set xs ≤ F ∧ length xs = n}. {x#xs})"
by (auto simp:length_Suc_conv)

lemma max_length_finite_set:"finite F ⟹ finite{xs. set xs <= F ∧ length xs = n}"
by(induct n,simp add:empty_list_set, simp add:suc_n_union_of_union)

lemma path_length_n_finite_set:
"wf_prog wf_md P ⟹ finite{Cs. Subobjs P C Cs ∧ length Cs = n}"
by (rule_tac B="{Cs. set Cs <= {C. is_class P C} ∧ length Cs = n}" in finite_subset,
  auto dest:path_contains_classes intro:max_length_finite_set simp:finite_is_class)

lemma path_finite_leq:
"wf_prog wf_md P ⟹ finite{Cs. Subobjs P C Cs ∧ length Cs ≤ length P}"
  by (induct ("length P"), simp only:empty_path_empty_set,
    auto intro:path_length_n_finite_set simp:split_set_path_length)

lemma path_finite:"wf_prog wf_md P ⟹ finite{Cs. Subobjs P C Cs}"
by (subgoal_tac "{Cs. Subobjs P C Cs} = 
  {Cs. Subobjs P C Cs ∧ length Cs ≤ length P}",
  auto intro:path_finite_leq path_length)


subsection‹Well-formedness and Path›

lemma path_via_reverse:
  assumes path_via:"P ⊢ Path C to D via Cs" and wf:"wf_prog wf_md P"
  shows "∀Cs'. P ⊢ Path D to C via Cs' ⟶ Cs = [C] ∧ Cs' = [C] ∧ C = D"
proof -
  from path_via have subo:"Subobjs P C Cs" and last:"last Cs = D"
    by(simp add:path_via_def)+
  hence leq:"P ⊢ C ≼⇧^* D" by(fastforce dest:Subobjs_subclass)
  { fix Cs' assume "P ⊢ Path D to C via Cs'"
    hence subo':"Subobjs P D Cs'" and last':"last Cs' = C"
      by(simp add:path_via_def)+
    hence leq':"P ⊢ D ≼⇧^* C" by(fastforce dest:Subobjs_subclass)
    with leq wf have CeqD:"C = D" by(rule subcls_asym2)
    moreover have Cs:"Cs = [C]" using CeqD subo last wf by(fastforce intro:mdc_eq_last)
    moreover have "Cs' = [C]" using CeqD subo' last' wf by(fastforce intro:mdc_eq_last)
    ultimately have "Cs = [C] ∧ Cs' = [C] ∧ C = D" by simp }
  thus ?thesis by blast
qed


lemma path_hd_appendPath:
  assumes path:"P,C ⊢ Cs ⊑ Cs'@⇩_pCs" and last:"last Cs' = hd Cs"
  and notemptyCs:"Cs ≠ []" and notemptyCs':"Cs' ≠ []" and wf:"wf_prog wf_md P"
  shows "Cs' = [hd Cs]"

using path
proof -
  from path notemptyCs last have path2:"P,C ⊢ Cs ⊑ Cs'@ tl Cs"
    by (simp add:appendPath_def)
  thus ?thesis
  proof (auto dest!:rtranclD)
    assume "Cs = Cs'@ tl Cs"
    with notemptyCs show "Cs' = [hd Cs]" by (rule app_hd_tl)
  next
    assume trancl:"(Cs,Cs'@ tl Cs) ∈ (leq_path1 P C)⇧⁺"
    from notemptyCs' last have butlastLast:"Cs' = butlast Cs' @ [hd Cs]"
      by -(drule append_butlast_last_id,simp)
    with trancl have trancl':"(Cs, (butlast Cs' @ [hd Cs]) @ tl Cs) ∈ (leq_path1 P C)⇧⁺"
      by simp
    from notemptyCs have "(butlast Cs' @ [hd Cs]) @ tl Cs = butlast Cs' @ Cs"
      by simp
    with trancl' have "(Cs, butlast Cs' @ Cs) ∈ (leq_path1 P C)⇧⁺" by simp
    hence "(last Cs, last (butlast Cs' @ Cs)) ∈ (subcls1 P)⇧⁺" using wf
      by (rule last_leq_paths)
    with notemptyCs have "(last Cs, last Cs) ∈ (subcls1 P)⇧⁺"
      by -(drule_tac xs="butlast Cs'" in last_appendR,simp)
    with wf show ?thesis by (auto dest:subcls_irrefl)
  qed
qed


lemma path_via_C: "⟦P ⊢ Path C to C via Cs; wf_prog wf_md P⟧ ⟹ Cs = [C]"
by (fastforce intro:mdc_eq_last simp:path_via_def)


lemma assumes wf:"wf_prog wf_md P"
  and path_via:"P ⊢ Path last Cs to C via Cs'"
  and path_via':"P ⊢ Path last Cs to C via Cs''"
  and appendPath:"Cs = Cs@⇩_pCs'"
shows appendPath_path_via:"Cs = Cs@⇩_pCs''"

proof -
  from path_via have notempty:"Cs' ≠ []"
    by(fastforce intro!:Subobjs_nonempty simp:path_via_def)
  { assume eq:"last Cs = hd Cs'"
    and Cs:"Cs = Cs@tl Cs'"
    from Cs have "tl Cs' = []" by simp
    with eq notempty have "Cs' = [last Cs]"
      by -(drule hd_Cons_tl,simp) }
  moreover
  { assume "Cs = Cs'"
    with wf path_via have "Cs' = [last Cs]"
      by(fastforce intro:mdc_eq_last simp:path_via_def) }
  ultimately have eq:"Cs' = [last Cs]" using appendPath
    by(simp add:appendPath_def,split if_split_asm,simp_all)
  with path_via have "C = last Cs"
    by(simp add:path_via_def)
  with wf path_via' have "Cs'' = [last Cs]"
    by simp(rule path_via_C)
  thus ?thesis by (simp add:appendPath_def)
qed



lemma subo_no_path:
  assumes subo:"Subobjs P C' (Cs @ C#Cs')" and wf:"wf_prog wf_md P"
  and notempty:"Cs' ≠ []"
  shows "¬ P ⊢ Path last Cs' to C via Ds"

proof
  assume "P ⊢ Path last Cs' to C via Ds"
  hence subo':"Subobjs P (last Cs') Ds" and last:"last Ds = C"
    by (auto simp:path_via_def)
  hence notemptyDs:"Ds ≠ []" by -(drule Subobjs_nonempty)
  then obtain D' Ds' where D'Ds':"Ds = D'#Ds'" by(cases Ds)auto
  from subo have suboC:"Subobjs P C (C#Cs')" by (rule Subobjs_Subobjs)
  with wf subo' notempty have suboapp:"Subobjs P C ((C#Cs')@⇩_pDs)"
    by -(rule Subobjs_appendPath,simp_all)
  with notemptyDs last have last':"last ((C#Cs')@⇩_pDs) = C"
    by -(drule_tac Cs'="(C#Cs')" in appendPath_last,simp)
  from notemptyDs have "(C#Cs')@⇩_pDs ≠ []"
    by (simp add:appendPath_def)
  with last' have "C ∈ set ((C#Cs')@⇩_pDs)"
    apply (auto simp add:in_set_conv_decomp)
    apply (rule_tac x="butlast((C#Cs')@⇩_pDs)" in exI)
    apply (rule_tac x="[]" in exI)
    apply (drule append_butlast_last_id)
    apply simp
    done
  with suboapp wf have hd:"C = hd ((C#Cs')@⇩_pDs)" by -(rule  mdc_hd_path)
  thus "False"
  proof (cases "last (C#Cs') = hd Ds")
    case True
    hence eq:"(C#Cs')@⇩_pDs = (C#Cs')@(tl Ds)" by (simp add:appendPath_def)
    show ?thesis
    proof (cases Ds')
      case Nil
      with D'Ds' have Ds:"Ds = [D']" by simp
      with last have "C = D'" by simp
      with True notempty Ds have "last (C#Cs') = C" by simp
      with notempty have "last Cs' = C" by simp
      with notempty have Cset:"C ∈ set Cs'"
        apply (auto simp add:in_set_conv_decomp)
        apply (rule_tac x="butlast Cs'" in exI)
        apply (rule_tac x="[]" in exI)
        apply (drule append_butlast_last_id)
        apply simp
        done
      from subo wf have "C ∉ set Cs'" by (rule unique1)
      with Cset show ?thesis by simp
    next
      case (Cons X Xs)
      with D'Ds' have tlnotempty:"tl Ds ≠ []" by simp
      with Cons last D'Ds' have "last (tl Ds) = C" by simp
      with tlnotempty have "C ∈ set (tl Ds)"
        apply (auto simp add:in_set_conv_decomp)
        apply (rule_tac x="butlast (tl Ds)" in exI)
        apply (rule_tac x="[]" in exI)
        apply (drule append_butlast_last_id)
        apply simp
        done
      hence Cset:"C ∈ set (Cs'@(tl Ds))" by simp
      from suboapp eq wf have "C ∉ set (Cs'@(tl Ds))"
        by (subgoal_tac "Subobjs P C (C#(Cs'@(tl Ds)))",
          rule_tac Cs="[]" in unique1,simp_all)
      with Cset show ?thesis by simp
    qed
  next
    case False
    with notemptyDs have eq:"(C#Cs')@⇩_pDs = Ds" by (simp add:appendPath_def)
    with subo' last have lastleq:"P ⊢ last Cs' ≼⇧^* C" 
      by (fastforce dest:Subobjs_subclass)
    from notempty obtain X Xs where X:"X = last Cs'" and "Xs = butlast Cs'"
      by auto
    with notempty have XXs:"Cs' = Xs@[X]" by simp
    hence CleqX:"(C,X) ∈ (subcls1 P)⇧⁺"
    proof (cases Xs)
      case Nil
      with suboC XXs have "Subobjs P C [C,X]" by simp
      thus ?thesis
        apply -
        apply (rule r_into_trancl)
        apply (rule subclsR_subcls1)
        apply (rule_tac Cs="[]" in Subobjs_subclsR)
        apply simp
        done
    next
      case (Cons Y Ys)
      with suboC XXs have subo'':"Subobjs P C ([C,Y]@Ys@[X])" by simp
      hence plus:"(C,Y) ∈ (subcls1 P)⇧⁺"
        apply -
        apply (rule r_into_trancl)
        apply (rule subclsR_subcls1)
        apply (rule_tac Cs="[]" in Subobjs_subclsR)
        apply simp
        done
      from subo'' have "P ⊢ Y ≼⇧^* X"
        apply -
        apply (subgoal_tac "Subobjs P C ([C]@Y#(Ys@[X]))")
         apply (drule Subobjs_Subobjs)
         apply (drule_tac C="Y" in Subobjs_subclass) apply simp_all
        done
      with plus show ?thesis by (fastforce elim:trancl_rtrancl_trancl)
    qed
    from lastleq X have leq:"P ⊢ X ≼⇧^* C" by simp
    with CleqX have "(C,C) ∈ (subcls1 P)⇧⁺"
      by (rule trancl_rtrancl_trancl)
    with wf show ?thesis by (fastforce dest:subcls_irrefl)
  qed
qed



lemma leq_implies_path:
  assumes leq:"P ⊢ C ≼⇧^* D" and "class": "is_class P C"
  and wf:"wf_prog wf_md P"
shows "∃Cs. P ⊢ Path C to D via Cs"

using leq "class"
proof(induct rule:rtrancl.induct)
  fix C assume "is_class P C"
  thus "∃Cs. P ⊢ Path C to C via Cs"
    by (rule_tac x="[C]" in exI,fastforce intro:Subobjs_Base simp:path_via_def)
next
  fix C C' D assume CleqC':"P ⊢ C ≼⇧^* C'" and C'leqD:"P ⊢ C' ≺⇧¹ D"
    and classC:"is_class P C" and IH:"is_class P C ⟹ ∃Cs. P ⊢ Path C to C' via Cs"
  from IH[OF classC] obtain Cs where subo:"Subobjs P C Cs" and last:"last Cs = C'"
    by (auto simp:path_via_def)
  with C'leqD show "∃Cs. P ⊢ Path C to D via Cs"
  proof (auto dest!:subcls1_subclsR_or_subclsS)
    assume "P ⊢ last Cs ≺⇩_R D"
    with subo have "Subobjs P C (Cs@[D])" using wf
      by (rule converse_Subobjs_Rep)
    thus ?thesis by (fastforce simp:path_via_def)
  next
    assume subS:"P ⊢ last Cs ≺⇩_S D"
    from CleqC' last have Cleqlast:"P ⊢ C ≼⇧^* last Cs" by simp
    from subS have classLast:"is_class P (last Cs)"
      by (auto intro:subcls1_class subclsS_subcls1)
    then obtain Bs fs ms where "class P (last Cs) = Some(Bs,fs,ms)"
      by (fastforce simp:is_class_def)
    hence classD:"is_class P D" using subS wf
      by (auto intro:wf_cdecl_supD dest:class_wf dest!:subclsSD 
               elim:ShBaseclass_isBaseclass)
    with Cleqlast subS have "Subobjs P C [D]"
      by (fastforce intro:Subobjs_Sh SubobjsR_Base)
    thus ?thesis by (fastforce simp:path_via_def)
  qed
qed


lemma least_method_implies_path_unique:
assumes least:"P ⊢ C has least M = (Ts,T,m) via Cs" and wf:"wf_prog wf_md P"
shows "P ⊢ Path C to (last Cs) unique"

proof (auto simp add:path_unique_def)
  (* Existence *)
  from least have "Subobjs P C Cs"
    by (simp add:LeastMethodDef_def MethodDefs_def)
  thus "∃Cs'. Subobjs P C Cs' ∧ last Cs' = last Cs"
    by fastforce
next
  (* Uniqueness *)
  fix Cs' Cs''
  assume suboCs':"Subobjs P C Cs'" and suboCs'':"Subobjs P C Cs''"
    and lastCs':"last Cs' = last Cs" and lastCs'':"last Cs'' = last Cs"
  from suboCs' have notemptyCs':"Cs' ≠ []" by (rule Subobjs_nonempty)
  from suboCs'' have notemptyCs'':"Cs'' ≠ []" by (rule Subobjs_nonempty)
  from least have suboCs:"Subobjs P C Cs"
    and all:"∀Ds. Subobjs P C Ds ∧ 
     (∃Ts T m Bs ms. (∃fs. class P (last Ds) = Some (Bs, fs, ms)) ∧ 
                 map_of ms M = Some(Ts,T,m)) ⟶ P,C ⊢ Cs ⊑ Ds"
    by (auto simp:LeastMethodDef_def MethodDefs_def)
  from least obtain Bs fs ms T Ts m where 
    "class": "class P (last Cs) = Some(Bs, fs, ms)" and map:"map_of ms M = Some(Ts,T,m)"
    by (auto simp:LeastMethodDef_def MethodDefs_def intro:that)
  from suboCs' lastCs' "class" map all have pathCs':"P,C ⊢ Cs ⊑ Cs'"
    by simp
  with wf lastCs' have eq:"Cs = Cs'" by(fastforce intro:leq_path_last)
  from suboCs'' lastCs'' "class" map all have pathCs'':"P,C ⊢ Cs ⊑ Cs''"
    by simp
  with wf lastCs'' have "Cs = Cs''" by(fastforce intro:leq_path_last)
  with eq show "Cs' = Cs''" by simp
qed



lemma least_field_implies_path_unique:
assumes least:"P ⊢ C has least F:T via Cs" and wf:"wf_prog wf_md P"
shows "P ⊢ Path C to (hd Cs) unique"

proof (auto simp add:path_unique_def)
  (* Existence *)
  from least have "Subobjs P C Cs"
    by (simp add:LeastFieldDecl_def FieldDecls_def)
  hence "Subobjs P C ([hd Cs]@tl Cs)"
    by - (frule Subobjs_nonempty,simp)
  with wf have "Subobjs P C [hd Cs]"
    by (fastforce intro:appendSubobj)
  thus "∃Cs'. Subobjs P C Cs' ∧ last Cs' = hd Cs"
    by fastforce
next
  (* Uniqueness *)
  fix Cs' Cs''
  assume suboCs':"Subobjs P C Cs'" and suboCs'':"Subobjs P C Cs''"
    and lastCs':"last Cs' = hd Cs" and lastCs'':"last Cs'' = hd Cs"
  from suboCs' have notemptyCs':"Cs' ≠ []" by (rule Subobjs_nonempty)
  from suboCs'' have notemptyCs'':"Cs'' ≠ []" by (rule Subobjs_nonempty)
  from least have suboCs:"Subobjs P C Cs"
    and all:"∀Ds. Subobjs P C Ds ∧ 
     (∃T Bs fs. (∃ms. class P (last Ds) = Some (Bs, fs, ms)) ∧ 
                 map_of fs F = Some T) ⟶ P,C ⊢ Cs ⊑ Ds"
    by (auto simp:LeastFieldDecl_def FieldDecls_def)
  from least obtain Bs fs ms T where 
    "class": "class P (last Cs) = Some(Bs, fs, ms)" and map:"map_of fs F = Some T"
    by (auto simp:LeastFieldDecl_def FieldDecls_def)
  from suboCs have notemptyCs:"Cs ≠ []" by (rule Subobjs_nonempty)
  from suboCs notemptyCs have suboHd:"Subobjs P (hd Cs) (hd Cs#tl Cs)"
    by -(rule_tac C="C" and Cs="[]" in Subobjs_Subobjs,simp)
  with suboCs' notemptyCs lastCs' wf have suboCs'App:"Subobjs P C (Cs'@⇩_pCs)"
    by -(rule Subobjs_appendPath,simp_all)
  from suboHd suboCs'' notemptyCs lastCs'' wf 
  have suboCs''App:"Subobjs P C (Cs''@⇩_pCs)"
    by -(rule Subobjs_appendPath,simp_all)
  from suboCs'App all "class" map notemptyCs have pathCs':"P,C ⊢ Cs ⊑ Cs'@⇩_pCs"
    by -(erule_tac x="Cs'@⇩_pCs" in allE,drule_tac Cs'="Cs'" in appendPath_last,simp)
  from suboCs''App all "class" map notemptyCs have pathCs'':"P,C ⊢ Cs ⊑ Cs''@⇩_pCs"
    by -(erule_tac x="Cs''@⇩_pCs" in allE,drule_tac Cs'="Cs''" in appendPath_last,simp)
  from pathCs' lastCs' notemptyCs notemptyCs' wf have Cs':"Cs' = [hd Cs]"
    by (rule path_hd_appendPath)
  from pathCs'' lastCs'' notemptyCs notemptyCs'' wf have "Cs'' = [hd Cs]"
    by (rule path_hd_appendPath)
  with Cs' show "Cs' = Cs''" by simp
qed



lemma least_field_implies_path_via_hd: 
"⟦P ⊢ C has least F:T via Cs; wf_prog wf_md P⟧ 
⟹ P ⊢ Path C to (hd Cs) via [hd Cs]"

apply (simp add:LeastFieldDecl_def FieldDecls_def)
apply clarsimp
apply (simp add:path_via_def)
apply (frule Subobjs_nonempty)
apply (rule_tac Cs'="tl Cs" in appendSubobj)
apply auto
done


lemma path_C_to_C_unique:
"⟦wf_prog wf_md P; is_class P C⟧ ⟹ P ⊢ Path C to C unique"

apply (unfold path_unique_def)
apply (rule_tac a="[C]" in ex1I)
apply (auto intro:Subobjs_Base mdc_eq_last)
done


lemma leqR_SubobjsR:"⟦(C,D) ∈ (subclsR P)⇧^*; is_class P C; wf_prog wf_md P⟧ 
⟹ ∃Cs. Subobjs⇩_R P C (Cs@[D])"

apply (induct rule:rtrancl_induct)
 apply (drule SubobjsR_Base)
 apply (rule_tac x="[]" in exI)
 apply simp
apply (auto dest:converse_SubobjsR_Rep)
done



lemma assumes path_unique:"P ⊢ Path C to D unique" and leq:"P ⊢ C ≼⇧^* C'"
  and leqR:"(C',D) ∈ (subclsR P)⇧^*" and wf:"wf_prog wf_md P"
  shows "P ⊢ Path C to C' unique"

proof -
  from path_unique have "is_class P C"
    by (auto intro:Subobjs_isClass simp:path_unique_def)
  with leq wf obtain Cs where path_via:"P ⊢ Path C to C' via Cs"
    by (auto dest:leq_implies_path)
  with wf have classC':"is_class P C'"
    by (fastforce intro:Subobj_last_isClass simp:path_via_def)
  with leqR wf obtain Cs' where subo:"Subobjs⇩_R P C' Cs'" and last:"last Cs' = D"
    by (auto dest:leqR_SubobjsR)
  hence hd:"hd Cs' = C'"
    by (fastforce dest:hd_SubobjsR)
  with path_via subo wf have suboApp:"Subobjs P C (Cs@tl Cs')"
    by (auto dest!:Subobjs_Rep dest:Subobjs_appendPath 
                simp:path_via_def appendPath_def)
  hence last':"last (Cs@tl Cs') = D"
    proof (cases "tl Cs' = []")
      case True
      with subo hd last have "C' = D"
        by (subgoal_tac "Cs' = [C']",auto dest!:SubobjsR_nonempty hd_Cons_tl)
      with path_via have "last Cs = D"
        by (auto simp:path_via_def)
      with True show ?thesis by simp
    next
      case False
      from subo have Cs':"Cs' = hd Cs'#tl Cs'"
        by (auto dest:SubobjsR_nonempty)
      from False have "last(hd Cs'#tl Cs') = last (tl Cs')"
        by (rule last_ConsR)
      with False Cs' last show ?thesis by simp
    qed
  with path_unique suboApp 
  have all:"∀Ds. Subobjs P C Ds ∧ last Ds = D ⟶ Ds = Cs@tl Cs'"
    by (auto simp add:path_unique_def)
  { fix Cs'' assume path_via2:"P ⊢ Path C to C' via Cs''" and noteq:"Cs'' ≠ Cs"
    with suboApp have "last (Cs''@tl Cs') = D"
    proof (cases "tl Cs' = []")
      case True
      with subo hd last have "C' = D"
        by (subgoal_tac "Cs' = [C']",auto dest!:SubobjsR_nonempty hd_Cons_tl)
      with path_via2 have "last Cs'' = D"
        by (auto simp:path_via_def)
      with True show ?thesis by simp
    next
      case False
      from subo have Cs':"Cs' = hd Cs'#tl Cs'"
        by (auto dest:SubobjsR_nonempty)
      from False have "last(hd Cs'#tl Cs') = last (tl Cs')"
        by (rule last_ConsR)
      with False Cs' last show ?thesis by simp
    qed
    with path_via2 noteq have False using all subo hd wf
      apply (auto simp:path_via_def)
      apply (drule Subobjs_Rep)
      apply (drule Subobjs_appendPath)
      apply (auto simp:appendPath_def)
      done }
  with path_via show ?thesis
    by (auto simp:path_via_def path_unique_def)
qed



subsection‹Well-formedness and member lookup›

lemma has_path_has:
"⟦P ⊢ Path D to C via Ds; P ⊢ C has M = (Ts,T,m) via Cs; wf_prog wf_md P⟧ 
  ⟹ P ⊢ D has M = (Ts,T,m) via Ds@⇩_pCs"
by (clarsimp simp:HasMethodDef_def MethodDefs_def,frule Subobjs_nonempty,
         drule_tac Cs'="Ds" in appendPath_last,
         fastforce intro:Subobjs_appendPath simp:path_via_def)


lemma has_least_wf_mdecl:
  "⟦ wf_prog wf_md P; P ⊢ C has least M = m via Cs ⟧ 
⟹ wf_mdecl wf_md P (last Cs) (M,m)"
by(fastforce dest:visible_methods_exist class_wf map_of_SomeD 
                 simp:LeastMethodDef_def wf_cdecl_def)



lemma has_overrider_wf_mdecl:
  "⟦ wf_prog wf_md P; P ⊢ (C,Cs) has overrider M = m via Cs' ⟧ 
⟹ wf_mdecl wf_md P (last Cs') (M,m)"
by(fastforce dest:visible_methods_exist map_of_SomeD class_wf
                 simp:FinalOverriderMethodDef_def OverriderMethodDefs_def 
                      MinimalMethodDefs_def wf_cdecl_def)


lemma select_method_wf_mdecl:
  "⟦ wf_prog wf_md P; P ⊢ (C,Cs) selects M = m via Cs' ⟧ 
⟹ wf_mdecl wf_md P (last Cs') (M,m)"
by(fastforce elim:SelectMethodDef.induct 
                 intro:has_least_wf_mdecl has_overrider_wf_mdecl)



lemma wf_sees_method_fun:
"⟦P ⊢ C has least M = mthd via Cs; P ⊢ C has least M = mthd' via Cs'; 
  wf_prog wf_md P⟧
  ⟹ mthd = mthd' ∧ Cs = Cs'"

apply (auto simp:LeastMethodDef_def)
apply (erule_tac x="(Cs', mthd')" in ballE)
apply (erule_tac x="(Cs, mthd)" in ballE)
apply auto
apply (drule leq_path_asym2) apply simp_all
apply (rule sees_methods_fun) apply simp_all
apply (erule_tac x="(Cs', mthd')" in ballE)
apply (erule_tac x="(Cs, mthd)" in ballE)
apply (auto intro:leq_path_asym2)
done


lemma wf_select_method_fun: 
  assumes wf:"wf_prog wf_md P"
  shows "⟦P ⊢ (C,Cs) selects M = mthd via Cs'; P ⊢ (C,Cs) selects M = mthd' via Cs''⟧
  ⟹ mthd = mthd' ∧ Cs' = Cs''"
proof(induct rule:SelectMethodDef.induct)
  case (dyn_unique C M mthd Cs' Cs)
  have "P ⊢ (C, Cs) selects M = mthd' via Cs''"
    and "P ⊢ C has least M = mthd via Cs'" by fact+
  thus ?case
  proof(induct rule:SelectMethodDef.induct)
    case (dyn_unique D M' mthd' Ds' Ds)
    have "P ⊢ D has least M' = mthd' via Ds'" 
      and "P ⊢ D has least M' = mthd via Cs'" by fact+
    with wf show ?case
      by -(rule wf_sees_method_fun,simp_all)
  next
    case (dyn_ambiguous D M' Ds mthd' Ds')
    have "∀mthd Cs'. ¬ P ⊢ D has least M' = mthd via Cs'"
      and "P ⊢ D has least M' = mthd via Cs'" by fact+
    thus ?case by blast
  qed
next
  case (dyn_ambiguous C M Cs mthd Cs')
  have "P ⊢ (C, Cs) selects M = mthd' via Cs''"
    and "P ⊢ (C, Cs) has overrider M = mthd via Cs'"
    and "∀mthd Cs'. ¬ P ⊢ C has least M = mthd via Cs'" by fact+
  thus ?case
  proof(induct rule:SelectMethodDef.induct)
    case (dyn_unique D M' mthd' Ds' Ds)
    have "P ⊢ D has least M' = mthd' via Ds'"
      and "∀mthd Cs'. ¬ P ⊢ D has least M' = mthd via Cs'" by fact+
    thus ?case by blast
  next
    case (dyn_ambiguous D M' Ds mthd' Ds')
    have "P ⊢ (D, Ds) has overrider M' = mthd' via Ds'"
      and "P ⊢ (D, Ds) has overrider M' = mthd via Cs'" by fact+
    thus ?case by(fastforce dest:overrider_method_fun)
  qed
qed




lemma least_field_is_type:
assumes field:"P ⊢ C has least F:T via Cs" and wf:"wf_prog wf_md P"
shows "is_type P T"

proof -
  from field have "(Cs,T) ∈ FieldDecls P C F"
    by (simp add:LeastFieldDecl_def)
  from this obtain Bs fs ms 
    where "map_of fs F = Some T" 
    and "class": "class P (last Cs) = Some (Bs,fs,ms)"
    by (auto simp add:FieldDecls_def)
  hence "(F,T) ∈ set fs" by (simp add:map_of_SomeD)
  with "class" wf show ?thesis
    by(fastforce dest!: class_wf simp: wf_cdecl_def wf_fdecl_def)
qed 



lemma least_method_is_type:
assumes "method":"P ⊢ C has least M = (Ts,T,m) via Cs" and wf:"wf_prog wf_md P"
shows "is_type P T"

proof -
  from "method" have "(Cs,Ts,T,m) ∈ MethodDefs P C M"
    by (simp add:LeastMethodDef_def)
  from this obtain Bs fs ms 
    where "map_of ms M = Some(Ts,T,m)" 
    and "class": "class P (last Cs) = Some (Bs,fs,ms)"
    by (auto simp add:MethodDefs_def)
  hence "(M,Ts,T,m) ∈ set ms" by (simp add:map_of_SomeD)
  with "class" wf show ?thesis
    by(fastforce dest!: class_wf simp: wf_cdecl_def wf_mdecl_def)
qed 



lemma least_overrider_is_type:
assumes "method":"P ⊢ (C,Cs) has overrider M = (Ts,T,m) via Cs'" 
  and wf:"wf_prog wf_md P"
shows "is_type P T"

proof -
  from "method" have "(Cs',Ts,T,m) ∈ MethodDefs P C M"
    by(clarsimp simp:FinalOverriderMethodDef_def OverriderMethodDefs_def 
                     MinimalMethodDefs_def)
  from this obtain Bs fs ms 
    where "map_of ms M = Some(Ts,T,m)" 
    and "class": "class P (last Cs') = Some (Bs,fs,ms)"
    by (auto simp add:MethodDefs_def)
  hence "(M,Ts,T,m) ∈ set ms" by (simp add:map_of_SomeD)
  with "class" wf show ?thesis
    by(fastforce dest!: class_wf simp: wf_cdecl_def wf_mdecl_def)
qed 



lemma select_method_is_type:
"⟦ P ⊢ (C,Cs) selects M = (Ts,T,m) via Cs'; wf_prog wf_md P⟧ ⟹ is_type P T"
by(auto elim:SelectMethodDef.cases
             intro:least_method_is_type least_overrider_is_type)


lemma base_subtype:
"⟦wf_cdecl wf_md P (C,Bs,fs,ms); C' ∈ baseClasses Bs; 
  P ⊢ C' has M = (Ts',T',m') via Cs@⇩_p[D]; (M,Ts,T,m)∈set ms⟧
  ⟹ Ts' = Ts ∧ P ⊢ T ≤ T'"

apply (simp add:wf_cdecl_def)
apply clarsimp
apply (rotate_tac -1)
apply (erule_tac x="C'" in ballE)
 apply clarsimp
 apply (rotate_tac -1)
 apply (erule_tac x="(M, Ts, T, m)" in ballE)
  apply clarsimp
  apply (erule_tac x="Ts'" in allE)
  apply (erule_tac x="T'" in allE)
  apply (auto simp:HasMethodDef_def)
 apply (erule_tac x="fst m'" in allE)
 apply (erule_tac x="snd m'" in allE)
 apply (erule_tac x="Cs@⇩_p[D]" in allE)
 apply simp
apply (erule_tac x="fst m'" in allE)
apply (erule_tac x="snd m'" in allE)
apply (erule_tac x="Cs@⇩_p[D]" in allE)
apply simp
done



lemma subclsPlus_subtype:
  assumes classD:"class P D = Some(Bs',fs',ms')" 
  and mapMs':"map_of ms' M = Some(Ts',T',m')"
  and leq:"(C,D) ∈ (subcls1 P)⇧⁺" and wf:"wf_prog wf_md P"
shows "∀Bs fs ms Ts T m. class P C = Some(Bs,fs,ms) ∧ map_of ms M = Some(Ts,T,m) 
    ⟶ Ts' = Ts ∧ P ⊢ T ≤ T'"

using leq classD mapMs'
proof (erule_tac a="C" and b="D" in converse_trancl_induct)
  fix C
  assume CleqD:"P ⊢ C ≺⇧¹ D" and classD1:"class P D = Some(Bs',fs',ms')"
  { fix Bs fs ms Ts T m
    assume classC:"class P C = Some(Bs,fs,ms)" and mapMs:"map_of ms M = Some(Ts,T,m)"
    from classD1 mapMs' have hasViaD:"P ⊢ D has M = (Ts',T',m') via [D]"
      by (fastforce intro:Subobjs_Base simp:HasMethodDef_def MethodDefs_def is_class_def)
    from CleqD classC have base:"D ∈ baseClasses Bs"
      by (fastforce dest:subcls1D)
    from classC wf have cdecl:"wf_cdecl wf_md P (C,Bs,fs,ms)"
      by (rule class_wf)
    from classC mapMs have "(M,Ts,T,m)∈set ms"
      by -(drule map_of_SomeD)
    with cdecl base hasViaD have "Ts' = Ts ∧ P ⊢ T ≤ T'"
      by -(rule_tac Cs="[D]" in base_subtype,auto simp:appendPath_def) }
  thus "∀Bs fs ms Ts T m. class P C = Some(Bs, fs, ms) ∧ map_of ms M = Some(Ts,T,m) 
             ⟶ Ts' = Ts ∧ P ⊢ T ≤ T'" by blast
next
  fix C C'
  assume  classD1:"class P D = Some(Bs',fs',ms')" and CleqC':"P ⊢ C ≺⇧¹ C'"
    and subcls:"(C',D) ∈ (subcls1 P)⇧⁺"
    and IH:"∀Bs fs ms Ts T m. class P C' = Some(Bs,fs,ms) ∧ 
                          map_of ms M = Some(Ts,T,m) ⟶ 
                  Ts' = Ts ∧ P ⊢ T ≤ T'"
  { fix Bs fs ms Ts T m
    assume classC:"class P C = Some(Bs,fs,ms)" and mapMs:"map_of ms M = Some(Ts,T,m)"
    from classD1 mapMs' have hasViaD:"P ⊢ D has M = (Ts',T',m') via [D]"
      by (fastforce intro:Subobjs_Base simp:HasMethodDef_def MethodDefs_def is_class_def)
    from subcls have C'leqD:"P ⊢ C' ≼⇧^* D" by simp
    from classC wf CleqC' have "is_class P C'"
      by (fastforce intro:wf_cdecl_supD class_wf dest:subcls1D)
    with C'leqD wf obtain Cs where "P ⊢ Path C' to D via Cs"
      by (auto dest!:leq_implies_path simp:is_class_def)
    hence hasVia:"P ⊢ C' has M = (Ts',T',m') via Cs@⇩_p[D]" using hasViaD wf
      by (rule has_path_has)
    from CleqC' classC have base:"C' ∈ baseClasses Bs"
      by (fastforce dest:subcls1D)
    from classC wf have cdecl:"wf_cdecl wf_md P (C,Bs,fs,ms)"
      by (rule class_wf)
    from classC mapMs have "(M,Ts,T,m)∈set ms"
      by -(drule map_of_SomeD)
    with cdecl base hasVia have "Ts' = Ts ∧ P ⊢ T ≤ T'"
      by(rule base_subtype) }
  thus "∀Bs fs ms Ts T m. class P C = Some(Bs, fs, ms) ∧ map_of ms M = Some(Ts,T,m) 
             ⟶ Ts' = Ts ∧ P ⊢ T ≤ T'" by blast
qed



lemma leq_method_subtypes:
  assumes leq:"P ⊢ D ≼⇧^* C" and least:"P ⊢ D has least M = (Ts',T',m') via Ds"
  and wf:"wf_prog wf_md P"
  shows "∀Ts T m Cs. P ⊢ C has M = (Ts,T,m) via Cs ⟶ 
                       Ts = Ts' ∧ P ⊢ T' ≤ T"
using assms
proof (induct rule:rtrancl.induct)
  fix C
  assume Cleast:"P ⊢ C has least M = (Ts',T',m') via Ds"
  { fix Ts T m Cs
    assume Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
    with Cleast have path:"P,C ⊢ Ds ⊑ Cs"
      by (fastforce simp:LeastMethodDef_def HasMethodDef_def)
    { assume "Ds = Cs"
      with Cleast Chas have "Ts = Ts' ∧ T' = T"
        by (auto simp:LeastMethodDef_def HasMethodDef_def MethodDefs_def)
      hence "Ts = Ts' ∧ P ⊢ T' ≤ T" by auto }
    moreover
    { assume "(Ds,Cs) ∈ (leq_path1 P C)⇧⁺"
      hence subcls:"(last Ds,last Cs) ∈ (subcls1 P)⇧⁺" using wf
        by -(rule last_leq_paths)
      from Chas obtain Bs fs ms where "class P (last Cs) = Some(Bs,fs,ms)" 
        and "map_of ms M = Some(Ts,T,m)"
        by (auto simp:HasMethodDef_def MethodDefs_def)
      hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧ 
        map_of ms' M = Some(Ts',T',m') ⟶ Ts = Ts' ∧ P ⊢ T' ≤ T"
        using subcls wf
        by -(rule subclsPlus_subtype,auto)
      from Cleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')" 
        and "map_of ms' M = Some(Ts',T',m')"
        by (auto simp:LeastMethodDef_def MethodDefs_def)
      with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
      ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using path
        by (auto dest!:rtranclD) }
  thus "∀Ts T m Cs. P ⊢ C has M = (Ts, T, m) via Cs ⟶ 
                      Ts = Ts' ∧ P ⊢ T' ≤ T"
    by (simp add:HasMethodDef_def MethodDefs_def)
next
  fix D C' C
  assume DleqC':"P ⊢ D ≼⇧^* C'" and C'leqC:"P ⊢ C' ≺⇧¹ C"
  and Dleast:"P ⊢ D has least M = (Ts',T',m') via Ds"
  and IH:"⟦P ⊢ D has least M = (Ts',T',m') via Ds; wf_prog wf_md P⟧
   ⟹ ∀Ts T m Cs. P ⊢ C' has M = (Ts, T, m) via Cs ⟶ 
            Ts = Ts' ∧ P ⊢ T' ≤ T"
  { fix Ts T m Cs
    assume Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
    from Dleast have classD:"is_class P D"
      by (auto intro:Subobjs_isClass simp:LeastMethodDef_def MethodDefs_def)
    from DleqC' C'leqC have "P ⊢ D ≼⇧^* C" by simp
    then obtain Cs' where "P ⊢ Path D to C via Cs'" using classD wf
      by (auto dest:leq_implies_path)
    hence Dhas:"P ⊢ D has M = (Ts,T,m) via Cs'@⇩_pCs" using Chas wf
      by (fastforce intro:has_path_has)
    with Dleast have path:"P,D ⊢ Ds ⊑ Cs'@⇩_pCs"
      by (auto simp:LeastMethodDef_def HasMethodDef_def)
    { assume "Ds = Cs'@⇩_pCs"
      with Dleast Dhas have "Ts = Ts' ∧ T' = T"
        by (auto simp:LeastMethodDef_def HasMethodDef_def MethodDefs_def)
      hence "Ts = Ts' ∧ T' = T" by auto }
    moreover
    { assume "(Ds,Cs'@⇩_pCs) ∈ (leq_path1 P D)⇧⁺"
      hence subcls:"(last Ds,last (Cs'@⇩_pCs)) ∈ (subcls1 P)⇧⁺" using wf
        by -(rule last_leq_paths)
      from Dhas obtain Bs fs ms where "class P (last (Cs'@⇩_pCs)) = Some(Bs,fs,ms)" 
        and "map_of ms M = Some(Ts,T,m)"
        by (auto simp:HasMethodDef_def MethodDefs_def)
      hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧ 
                 map_of ms' M = Some(Ts',T',m') ⟶ 
                     Ts = Ts' ∧ P ⊢ T' ≤ T"
        using subcls wf
        by -(rule subclsPlus_subtype,auto)
      from Dleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')" 
        and "map_of ms' M = Some(Ts',T',m')"
        by (auto simp:LeastMethodDef_def MethodDefs_def)
      with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
    ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using path
      by (auto dest!:rtranclD) }
  thus "∀Ts T m Cs. P ⊢ C has M = (Ts, T, m) via Cs ⟶ 
            Ts = Ts' ∧ P ⊢ T' ≤ T"
    by simp
qed



lemma leq_methods_subtypes:
  assumes leq:"P ⊢ D ≼⇧^* C" and least:"(Ds,(Ts',T',m')) ∈ MinimalMethodDefs P D M"
  and wf:"wf_prog wf_md P"
  shows "∀Ts T m Cs Cs'. P ⊢ Path D to C via Cs' ∧ P,D ⊢ Ds ⊑ Cs'@⇩_pCs ∧ Cs ≠ [] ∧ 
                         P ⊢ C has M = (Ts,T,m) via Cs 
                                ⟶  Ts = Ts' ∧ P ⊢ T' ≤ T"
using assms
proof (induct rule:rtrancl.induct)
  fix C
  assume Cleast:"(Ds,(Ts',T',m')) ∈ MinimalMethodDefs P C M"
  { fix Ts T m Cs Cs'
    assume path':"P ⊢ Path C to C via Cs'"
      and leq_path:"P,C ⊢ Ds ⊑ Cs' @⇩_p Cs" and notempty:"Cs ≠ []"
      and Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
    from path' wf have Cs':"Cs' = [C]" by(rule path_via_C)
    from leq_path Cs' notempty have leq':"P,C ⊢ Ds ⊑ Cs"
      by(auto simp:appendPath_def split:if_split_asm)
    { assume "Ds = Cs"
      with Cleast Chas have "Ts = Ts' ∧ T' = T"
        by (auto simp:MinimalMethodDefs_def HasMethodDef_def MethodDefs_def)
      hence "Ts = Ts' ∧ P ⊢ T' ≤ T" by auto }
    moreover
    { assume "(Ds,Cs) ∈ (leq_path1 P C)⇧⁺"
      hence subcls:"(last Ds,last Cs) ∈ (subcls1 P)⇧⁺" using wf
        by -(rule last_leq_paths)
      from Chas obtain Bs fs ms where "class P (last Cs) = Some(Bs,fs,ms)" 
        and "map_of ms M = Some(Ts,T,m)"
        by (auto simp:HasMethodDef_def MethodDefs_def)
      hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧ 
        map_of ms' M = Some(Ts',T',m') ⟶ Ts = Ts' ∧ P ⊢ T' ≤ T"
        using subcls wf
        by -(rule subclsPlus_subtype,auto)
      from Cleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')" 
        and "map_of ms' M = Some(Ts',T',m')"
        by (auto simp:MinimalMethodDefs_def MethodDefs_def)
      with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
      ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using leq'
        by (auto dest!:rtranclD) }
  thus "∀Ts T m Cs Cs'. P ⊢ Path C to C via Cs' ∧ P,C ⊢ Ds ⊑ Cs' @⇩_p Cs ∧ Cs ≠ [] ∧ 
                        P ⊢ C has M = (Ts, T, m) via Cs ⟶ 
                            Ts = Ts' ∧ P ⊢ T' ≤ T" by blast
next
  fix D C' C
  assume DleqC':"P ⊢ D ≼⇧^* C'" and C'leqC:"P ⊢ C' ≺⇧¹ C"
    and Dleast:"(Ds, Ts', T', m') ∈ MinimalMethodDefs P D M"
    and IH:"⟦(Ds,Ts',T',m') ∈ MinimalMethodDefs P D M; wf_prog wf_md P⟧
   ⟹ ∀Ts T m Cs Cs'. P ⊢ Path D to C' via Cs' ∧
              P,D ⊢ Ds ⊑ Cs' @⇩_p Cs ∧ Cs ≠ [] ∧ P ⊢ C' has M = (Ts, T, m) via Cs ⟶ 
                             Ts = Ts' ∧ P ⊢ T' ≤ T"
  { fix Ts T m Cs Cs'
    assume path:"P ⊢ Path D to C via Cs'"
      and leq_path:"P,D ⊢ Ds ⊑ Cs' @⇩_p Cs"
      and notempty:"Cs ≠ []"
      and Chas:"P ⊢ C has M = (Ts,T,m) via Cs"
    from Dleast have classD:"is_class P D"
      by (auto intro:Subobjs_isClass simp:MinimalMethodDefs_def MethodDefs_def)
    from path have Dhas:"P ⊢ D has M = (Ts,T,m) via Cs'@⇩_pCs" using Chas wf
      by (fastforce intro:has_path_has)
    { assume "Ds = Cs'@⇩_pCs"
      with Dleast Dhas have "Ts = Ts' ∧ T' = T"
        by (auto simp:MinimalMethodDefs_def HasMethodDef_def MethodDefs_def)
      hence "Ts = Ts' ∧ T' = T" by auto }
    moreover
    { assume "(Ds,Cs'@⇩_pCs) ∈ (leq_path1 P D)⇧⁺"
      hence subcls:"(last Ds,last (Cs'@⇩_pCs)) ∈ (subcls1 P)⇧⁺" using wf
        by -(rule last_leq_paths)
      from Dhas obtain Bs fs ms where "class P (last (Cs'@⇩_pCs)) = Some(Bs,fs,ms)" 
        and "map_of ms M = Some(Ts,T,m)"
        by (auto simp:HasMethodDef_def MethodDefs_def)
      hence ex:"∀Bs' fs' ms' Ts' T' m'. class P (last Ds) = Some(Bs',fs',ms') ∧ 
                 map_of ms' M = Some(Ts',T',m') ⟶ 
                     Ts = Ts' ∧ P ⊢ T' ≤ T"
        using subcls wf
        by -(rule subclsPlus_subtype,auto)
      from Dleast obtain Bs' fs' ms' where "class P (last Ds) = Some(Bs',fs',ms')" 
        and "map_of ms' M = Some(Ts',T',m')"
        by (auto simp:MinimalMethodDefs_def MethodDefs_def)
      with ex have "Ts = Ts'" and "P ⊢ T' ≤ T" by auto }
    ultimately have "Ts = Ts'" and "P ⊢ T' ≤ T" using leq_path
      by (auto dest!:rtranclD) }
  thus "∀Ts T m Cs Cs'. P ⊢ Path D to C via Cs' ∧ P,D ⊢ Ds ⊑ Cs' @⇩_p Cs ∧ Cs ≠ [] ∧ 
                    P ⊢ C has M = (Ts, T, m) via Cs ⟶ 
                           Ts = Ts' ∧ P ⊢ T' ≤ T"
    by blast
qed


lemma select_least_methods_subtypes: 
  assumes select_method:"P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
  and least_method:"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
  and path:"P ⊢ Path C to (last Cs) via Cs"
  and wf:"wf_prog wf_md P"
  shows "Ts' = Ts ∧ P ⊢ T ≤ T'"
using select_method
proof -
  from path have sub:"P ⊢ C ≼⇧^* last Cs"
    by(fastforce intro:Subobjs_subclass simp:path_via_def)
  from least_method have has:"P ⊢ last Cs has M = (Ts',T',pns',body') via Ds"
    by(rule has_least_method_has_method)
  from select_method show ?thesis
  proof cases
    case dyn_unique
    hence dyn:"P ⊢ C has least M = (Ts,T,pns,body) via Cs'" by simp
    with sub has wf show ?thesis
      by -(drule leq_method_subtypes,assumption,simp,blast)+
  next
    case dyn_ambiguous
    hence overrider:"P ⊢ (C,Cs@⇩_pDs) has overrider M = (Ts,T,pns,body) via Cs'" 
      by simp
    from least_method have notempty:"Ds ≠ []"
      by(auto intro!:Subobjs_nonempty simp:LeastMethodDef_def MethodDefs_def)
    have "last Cs = hd Ds ⟹ last (Cs @ tl Ds) = last Ds"
    proof(cases "tl Ds = []")
      case True
      assume last:"last Cs = hd Ds"
      with True notempty have "Ds = [last Cs]" by (fastforce dest:hd_Cons_tl)
      hence "last Ds = last Cs" by simp
      with True show ?thesis by simp
    next
      case False
      assume last:"last Cs = hd Ds"
      from notempty False have "last (tl Ds) = last Ds"
        by -(drule hd_Cons_tl,drule_tac x="hd Ds" in last_ConsR,simp)
      with False show ?thesis by simp
    qed
    hence eq:"(Cs @⇩_p Ds) @⇩_p [last Ds] = (Cs @⇩_p Ds)"
      by(simp add:appendPath_def)
    from least_method wf
    have "P ⊢ last Ds has least M = (Ts',T',pns',body') via [last Ds]"
      by(auto dest:Subobj_last_isClass intro:Subobjs_Base subobjs_rel
        simp:LeastMethodDef_def MethodDefs_def)
    with notempty
    have "P ⊢ last (Cs@⇩_pDs) has least M = (Ts',T',pns',body') via [last Ds]"
      by -(drule_tac Cs'="Cs" in appendPath_last,simp)
    with overrider wf eq have "(Cs',Ts,T,pns,body) ∈ MinimalMethodDefs P C M"
      and "P,C ⊢ Cs' ⊑ Cs @⇩_p Ds"
      by -(auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def,
        drule wf_sees_method_fun,auto)
    with sub wf path notempty has show ?thesis
      by -(drule leq_methods_subtypes,simp_all,blast)+
  qed
qed



lemma wf_syscls:
  "set SystemClasses ⊆ set P ⟹ wf_syscls P"
by (simp add: image_def SystemClasses_def wf_syscls_def sys_xcpts_def
          NullPointerC_def ClassCastC_def OutOfMemoryC_def,force intro:conjI)


subsection‹Well formedness and widen›

lemma Class_widen: "⟦P ⊢ Class C ≤ T; wf_prog wf_md P; is_class P C⟧  
  ⟹  ∃D. T = Class D ∧ P ⊢ Path C to D unique"

apply (ind_cases "P ⊢ Class C ≤ T")
apply (auto intro:path_C_to_C_unique)
done


lemma Class_widen_Class [iff]: "⟦wf_prog wf_md P; is_class P C⟧ ⟹ 
  (P ⊢ Class C ≤ Class D) = (P ⊢ Path C to D unique)"

apply (rule iffI)
apply (ind_cases " P ⊢ Class C ≤ Class D")
apply (auto elim: widen_subcls intro:path_C_to_C_unique)
done


lemma widen_Class: "⟦wf_prog wf_md P; is_class P C⟧ ⟹ 
  (P ⊢ T ≤ Class C) = 
    (T = NT ∨ (∃D. T = Class D ∧ P ⊢ Path D to C unique))"

apply(induct T) apply (auto intro:widen_subcls)
apply (ind_cases "P ⊢ Class D ≤ Class C" for D) apply (auto intro:path_C_to_C_unique)
done



subsection‹Well formedness and well typing›

lemma assumes wf:"wf_prog wf_md P" 
shows WT_determ: "P,E ⊢ e :: T ⟹ (⋀T'. P,E ⊢ e :: T' ⟹ T = T')"
and WTs_determ: "P,E ⊢ es [::] Ts ⟹ (⋀Ts'. P,E ⊢ es [::] Ts' ⟹ Ts = Ts')"

proof(induct rule:WT_WTs_inducts)
  case (WTDynCast E e D C)
  have "P,E ⊢ Cast C e :: T'" by fact
  thus ?case by (fastforce elim:WT.cases)
next
  case (WTStaticCast E e D C)
  have "P,E ⊢ ⦇C⦈e :: T'" by fact
  thus ?case by (fastforce elim:WT.cases)
next
  case (WTBinOp E e⇩₁ T⇩₁ e⇩₂ T⇩₂ bop T)
  have bop:"case bop of Eq ⇒ T⇩₁ = T⇩₂ ∧ T = Boolean
    | Add ⇒ T⇩₁ = Integer ∧ T⇩₂ = Integer ∧ T = Integer"
    and wt:"P,E ⊢ e⇩₁ «bop» e⇩₂ :: T'" by fact+
  from wt obtain T1' T2' where
    bop':"case bop of Eq ⇒ T1' = T2' ∧ T' = Boolean
    | Add ⇒ T1' = Integer ∧ T2' = Integer ∧ T' = Integer"
    by auto
  from bop show ?case
  proof (cases bop)
    assume Eq:"bop = Eq"
    with bop have "T = Boolean" by auto
    with Eq bop' show ?thesis by simp
  next
    assume Add:"bop = Add"
    with bop have "T = Integer"
      by auto
    with Add bop' show ?thesis by simp
  qed
next
  case (WTLAss E V T e T' T'')
  have "P,E ⊢ V:=e :: T''" 
    and "E V = Some T" by fact+
  thus ?case by auto
next
  case (WTFAcc E e C F T Cs)
  have IH:"⋀T'. P,E ⊢ e :: T' ⟹ Class C = T'"
    and least:"P ⊢ C has least F:T via Cs"
    and wt:"P,E ⊢ e∙F{Cs} :: T'" by fact+
  from wt obtain C' where wte':"P,E ⊢ e :: Class C'"
    and least':"P ⊢ C' has least F:T' via Cs" by auto
  from IH[OF wte'] have "C = C'" by simp
  with least least' show ?case
    by (fastforce simp:sees_field_fun)
next
  case (WTFAss E e⇩₁ C F T Cs e⇩₂ T' T'')
  have least:"P ⊢ C has least F:T via Cs"
    and wt:"P,E ⊢ e⇩₁∙F{Cs} := e⇩₂ :: T''" 
    and IH:"⋀S. P,E ⊢ e⇩₁ :: S ⟹ Class C = S" by fact+
  from wt obtain C' where wte':"P,E ⊢ e⇩₁ :: Class C'" 
    and least':"P ⊢ C' has least F:T'' via Cs" by auto
  from IH[OF wte'] have "C = C'" by simp
  with least least' show ?case
    by (fastforce simp:sees_field_fun)
next
  case (WTCall E e C M Ts T pns body Cs es Ts')
  have IH:"⋀T'. P,E ⊢ e :: T' ⟹ Class C = T'"
    and least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
    and wt:"P,E ⊢ e∙M(es) :: T'" by fact+
  from wt obtain C' Ts' pns' body' Cs' where wte':"P,E ⊢ e :: Class C'"
    and least':"P ⊢ C' has least M = (Ts',T',pns',body') via Cs'" by auto
  from IH[OF wte'] have "C = C'" by simp
  with least least' wf show ?case by (auto dest:wf_sees_method_fun)
next
  case (WTStaticCall E e C' C M Ts T pns body Cs es Ts')
  have IH:"⋀T'. P,E ⊢ e :: T' ⟹ Class C' = T'" 
    and unique:"P ⊢ Path C' to C unique"
    and least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
    and wt:"P,E ⊢ e∙(C::)M(es) :: T'" by fact+
  from wt obtain Ts' pns' body' Cs' 
    where "P ⊢ C has least M = (Ts',T',pns',body') via Cs'" by auto
  with least wf show ?case by (auto dest:wf_sees_method_fun)
next
  case WTBlock thus ?case by (clarsimp simp del:fun_upd_apply)
next
  case (WTSeq E e⇩₁ T⇩₁ e⇩₂ T⇩₂)
  have IH:"⋀T'. P,E ⊢ e⇩₂ :: T' ⟹ T⇩₂ = T'"
    and wt:"P,E ⊢ e⇩₁;; e⇩₂ :: T'" by fact+
  from wt have wt':"P,E ⊢ e⇩₂ :: T'" by auto
  from IH[OF wt'] show ?case .
next
  case (WTCond E e e⇩₁ T e⇩₂)
  have IH:"⋀S. P,E ⊢ e⇩₁ :: S ⟹ T = S"
    and wt:"P,E ⊢ if (e) e⇩₁ else e⇩₂ :: T'" by fact+
  from wt have "P,E ⊢ e⇩₁ :: T'" by auto
  from IH[OF this] show ?case .
next
  case (WTCons E e T es Ts)
  have IHe:"⋀T'. P,E ⊢ e :: T' ⟹ T = T'"
    and IHes:"⋀Ts'. P,E ⊢ es [::] Ts' ⟹ Ts = Ts'"
    and wt:"P,E ⊢ e # es [::] Ts'" by fact+
  from wt show ?case
  proof (cases Ts')
    case Nil with wt show ?thesis by simp
  next
    case (Cons T'' Ts'')
    with wt have wte':"P,E ⊢ e :: T''" and wtes':"P,E ⊢ es [::] Ts''"
      by auto
    from IHe[OF wte'] IHes[OF wtes'] Cons show ?thesis by simp
  qed
qed clarsimp+

end

Theory Equivalence

(*  Title:       CoreC++

    Author:      Daniel Wasserrab
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>

    Based on the Jinja theory J/Equivalence.thy by Tobias Nipkow
*)

section ‹Equivalence of Big Step and Small Step Semantics›

theory Equivalence imports BigStep SmallStep WWellForm begin


subsection‹Some casts-lemmas›

lemma assumes wf:"wf_prog wf_md P"
shows casts_casts:
"P ⊢ T casts v to v' ⟹ P ⊢ T casts v' to v'"

proof(induct rule:casts_to.induct)
  case casts_prim thus ?case by(rule casts_to.casts_prim)
next
  case (casts_null C) thus ?case by(rule casts_to.casts_null)
next
  case (casts_ref Cs C Cs' Ds a)
  have path_via:"P ⊢ Path last Cs to C via Cs'" and Ds:"Ds = Cs @⇩_p Cs'" by fact+
  with wf have "last Cs' = C" and "Cs' ≠ []" and "class": "is_class P C"
    by(auto intro!:Subobjs_nonempty Subobj_last_isClass simp:path_via_def)
  with Ds have last:"last Ds = C"
    by -(drule_tac Cs' = "Cs" in appendPath_last,simp)
  hence Ds':"Ds = Ds @⇩_p [C]" by(simp add:appendPath_def)
  from last "class" have "P ⊢ Path last Ds to C via [C]"
    by(fastforce intro:Subobjs_Base simp:path_via_def)
  with Ds' show ?case by(fastforce intro:casts_to.casts_ref)
qed



lemma casts_casts_eq:
"⟦ P ⊢ T casts v to v; P ⊢ T casts v to v'; wf_prog wf_md P ⟧ ⟹ v = v'"

  apply -
  apply(erule casts_to.cases)
    apply clarsimp
    apply(erule casts_to.cases)
      apply simp
     apply simp
    apply (simp (asm_lr))
   apply(erule casts_to.cases)
     apply simp
    apply simp
   apply simp
  apply simp
  apply(erule casts_to.cases)
    apply simp
   apply simp
  apply clarsimp
  apply(erule appendPath_path_via)
  by auto



lemma assumes wf:"wf_prog wf_md P"
shows None_lcl_casts_values:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
  (⋀V. ⟦l V = None; E V = Some T; l' V = Some v'⟧
  ⟹ P ⊢ T casts v' to v')"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
  (⋀V. ⟦l V = None; E V = Some T; l' V = Some v'⟧
  ⟹ P ⊢ T casts v' to v')"

proof(induct rule:red_reds_inducts)
  case (RedLAss E V T' w w' h l V')
  have env:"E V = Some T'" and env':"E V' = Some T"
    and l:"l V' = None" and lupd:"(l(V ↦ w')) V' = Some v'"
    and casts:"P ⊢ T' casts w to w'" by fact+
  show ?case
  proof(cases "V = V'")
    case True
    with lupd have v':"v' = w'" by simp
    from True env env' have "T = T'" by simp
    with v' casts wf show ?thesis by(fastforce intro:casts_casts)
  next
    case False
    with lupd have "l V' = Some v'" by(fastforce split:if_split_asm)
    with l show ?thesis by simp
  qed
next
  case (BlockRedNone E V T' e h l e' h' l' V')
  have l:"l V' = None"
    and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
    and IH:"⋀V'. ⟦(l(V := None)) V' = None; (E(V ↦ T')) V' = Some T; 
                   l' V' = Some v'⟧
            ⟹ P ⊢ T casts v' to v'" by fact+
  show ?case
  proof(cases "V = V'")
    case True 
    with l'upd l show ?thesis by fastforce
  next
    case False
    with l  l'upd have lnew:"(l(V := None)) V' = None"
      and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
    from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
    from IH[OF lnew env' l'new] show ?thesis .
  qed
next
  case (BlockRedSome E V T' e h l e' h' l' v V')
  have l:"l V' = None"
    and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
    and IH:"⋀V'. ⟦(l(V := None)) V' = None; (E(V ↦ T')) V' = Some T; 
                   l' V' = Some v'⟧
            ⟹ P ⊢ T casts v' to v'" by fact+
  show ?case
  proof(cases "V = V'")
    case True
    with l l'upd show ?thesis by fastforce
  next
    case False
    with l  l'upd have lnew:"(l(V := None)) V' = None"
      and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
    from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
    from IH[OF lnew env' l'new] show ?thesis .
  qed
next
  case (InitBlockRed E V T' e h l w' e' h' l' w'' w V')
  have l:"l V' = None"
    and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
    and IH:"⋀V'. ⟦(l(V ↦ w')) V' = None; (E(V ↦ T')) V' = Some T; 
                   l' V' = Some v'⟧
            ⟹ P ⊢ T casts v' to v'" by fact+
  show ?case
  proof(cases "V = V'")
    case True
    with l l'upd show ?thesis by fastforce
  next
    case False
    with l  l'upd have lnew:"(l(V ↦ w')) V' = None"
      and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
    from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
    from IH[OF lnew env' l'new] show ?thesis .
  qed
qed (auto intro:casts_casts wf)



lemma assumes wf:"wf_prog wf_md P"
shows Some_lcl_casts_values:
"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
  (⋀V. ⟦l V = Some v; E V = Some T;
      P ⊢ T casts v'' to v; l' V = Some v'⟧
  ⟹ P ⊢ T casts v' to v')"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
  (⋀V. ⟦l V = Some v; E V = Some T;
      P ⊢ T casts v'' to v; l' V = Some v'⟧
  ⟹ P ⊢ T casts v' to v')"

proof(induct rule:red_reds_inducts)
  case (RedNew h a h' C' E l V)
  have l1:"l V = Some v" and l2:"l V = Some v'"
    and casts:"P ⊢ T casts v'' to v " by fact+
  from l1 l2 have eq:"v = v'" by simp
  with casts wf show ?case by(fastforce intro:casts_casts)
next
  case (RedLAss E V T' w w' h l V')
  have l:"l V' = Some v" and lupd:"(l(V ↦ w')) V' = Some v'"
    and T'casts:"P ⊢ T' casts w to w'"
    and env:"E V = Some T'" and env':"E V' = Some T"
    and casts:"P ⊢ T casts v'' to v" by fact+
  show ?case
  proof (cases "V = V'")
    case True
    with lupd have v':"v' = w'" by simp
    from True env env' have "T = T'" by simp
    with T'casts v' wf show ?thesis by(fastforce intro:casts_casts)
  next
    case False
    with l lupd have "v = v'" by (auto split:if_split_asm)
    with casts wf show ?thesis by(fastforce intro:casts_casts)
  qed
next
  case (RedFAss h a D S Cs' F T' Cs w w' Ds fs E l V)
  have l1:"l V = Some v" and l2:"l V = Some v'"
    and hp:"h a = Some(D, S)"
    and T'casts:"P ⊢ T' casts w to w'"
    and casts:"P ⊢ T casts v'' to v" by fact+
  from l1 l2 have eq:"v = v'" by simp
  with casts wf show ?case by(fastforce intro:casts_casts)
next
  case (BlockRedNone E V T' e h l e' h' l' V')
  have l':"l' V = None" and l:"l V' = Some v"
    and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
    and casts:"P ⊢ T casts v'' to v"
    and IH:"⋀V'. ⟦(l(V := None)) V' = Some v; (E(V ↦ T')) V' = Some T; 
                  P ⊢ T casts v'' to v ; l' V' = Some v'⟧
            ⟹ P ⊢ T casts v' to v'" by fact+
  show ?case
  proof(cases "V = V'")
    case True
    with l' l'upd have "l V = Some v'" by auto
    with True l have eq:"v = v'" by simp
    with casts wf show ?thesis by(fastforce intro:casts_casts)
  next
    case False
    with l  l'upd have lnew:"(l(V := None)) V' = Some v"
      and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
    from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
    from IH[OF lnew env' casts l'new] show ?thesis .
  qed
next
  case (BlockRedSome E V T' e h l e' h' l' w V')
  have l':"l' V = Some w" and l:"l V' = Some v"
    and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
    and casts:"P ⊢ T casts v'' to v"
    and IH:"⋀V'. ⟦(l(V := None)) V' = Some v; (E(V ↦ T')) V' = Some T; 
                   P ⊢ T casts v'' to v ; l' V' = Some v'⟧
            ⟹ P ⊢ T casts v' to v'" by fact+
  show ?case
  proof(cases "V = V'")
    case True
    with l' l'upd have "l V = Some v'" by auto
    with True l have eq:"v = v'" by simp
    with casts wf show ?thesis by(fastforce intro:casts_casts)
  next
    case False
    with l  l'upd have lnew:"(l(V := None)) V' = Some v"
      and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
    from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
    from IH[OF lnew env' casts l'new] show ?thesis .
  qed
next
  case (InitBlockRed E V T' e h l w' e' h' l' w'' w V')
  have l:"l V' = Some v" and l':"l' V = Some w''"
    and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
    and casts:"P ⊢ T casts v'' to v"
    and IH:"⋀V'. ⟦(l(V ↦ w')) V' = Some v; (E(V ↦ T')) V' = Some T; 
                   P ⊢ T casts v'' to v ; l' V' = Some v'⟧
            ⟹ P ⊢ T casts v' to v'" by fact+
  show ?case
  proof(cases "V = V'")
    case True
    with l' l'upd have "l V = Some v'" by auto
    with True l have eq:"v = v'" by simp
    with casts wf show ?thesis by(fastforce intro:casts_casts)
  next
    case False
    with l  l'upd have lnew:"(l(V ↦ w')) V' = Some v"
      and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
    from env False have env':"(E(V ↦ T')) V' = Some T" by fastforce
    from IH[OF lnew env' casts l'new] show ?thesis .
  qed
qed (auto intro:casts_casts wf)

  


subsection‹Small steps simulate big step›

subsection ‹Cast›

lemma StaticCastReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨⦇C⦈e',s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply (simp add:StaticCastRed)
done


lemma StaticCastRedsNull:
  "P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨null,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule StaticCastReds)
apply(simp add:RedStaticCastNull)
done


lemma StaticUpCastReds:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩_pCs' ⟧ 
  ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨ref(a,Ds),s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule StaticCastReds)
apply(fastforce intro:RedStaticUpCast)
done


lemma StaticDownCastReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs@[C]@Cs'),s'⟩
  ⟹  P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨ref(a,Cs@[C]),s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule StaticCastReds)
apply simp
apply(subgoal_tac "P,E ⊢ ⟨⦇C⦈ref(a,Cs@[C]@Cs'),s'⟩ → ⟨ref(a,Cs@[C]),s'⟩")
 apply simp
apply(rule RedStaticDownCast)
done


lemma StaticCastRedsFail:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; C ∉ set Cs; ¬ P ⊢ (last Cs) ≼⇧^* C ⟧
  ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨THROW ClassCast,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule StaticCastReds)
apply(fastforce intro:RedStaticCastFail)
done


lemma StaticCastRedsThrow:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟧ ⟹ P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨Throw r,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule StaticCastReds)
apply(simp add:red_reds.StaticCastThrow)
done


lemma DynCastReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨Cast C e',s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply (simp add:DynCastRed)
done


lemma DynCastRedsNull:
  "P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨null,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule DynCastReds)
apply(simp add:RedDynCastNull)
done


lemma DynCastRedsRef:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; hp s' a = Some (D,S); P ⊢ Path D to C via Cs';
     P ⊢ Path D to C unique ⟧ 
 ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨ref(a,Cs'),s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule DynCastReds)
apply(fastforce intro:RedDynCast)
done


lemma StaticUpDynCastReds:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; P ⊢ Path last Cs to C unique;
  P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩_pCs' ⟧ 
  ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨ref(a,Ds),s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule DynCastReds)
apply(fastforce intro:RedStaticUpDynCast)
done


lemma StaticDownDynCastReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs@[C]@Cs'),s'⟩
  ⟹  P,E ⊢ ⟨Cast C e,s⟩ →* ⟨ref(a,Cs@[C]),s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule DynCastReds)
apply simp
apply(subgoal_tac "P,E ⊢ ⟨Cast C (ref(a,Cs@[C]@Cs')),s'⟩ → ⟨ref(a,Cs@[C]),s'⟩")
 apply simp
apply(rule RedStaticDownDynCast)
done


lemma DynCastRedsFail:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs),s'⟩; hp s' a = Some (D,S); ¬ P ⊢ Path D to C unique;
    ¬ P ⊢ Path last Cs to C unique; C ∉ set Cs ⟧
  ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨null,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule DynCastReds)
apply(fastforce intro:RedDynCastFail)
done


lemma DynCastRedsThrow:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟧ ⟹ P,E ⊢ ⟨Cast C e,s⟩ →* ⟨Throw r,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule DynCastReds)
apply(simp add:red_reds.DynCastThrow)
done


subsection ‹LAss›

lemma LAssReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨V:=e,s⟩ →* ⟨V:=e',s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:LAssRed)
done


lemma LAssRedsVal:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Val v,(h',l')⟩; E V = Some T; P ⊢ T casts v to v'⟧ 
  ⟹ P,E ⊢ ⟨ V:=e,s⟩ →* ⟨Val v',(h',l'(V↦v'))⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule LAssReds)
apply(simp add:RedLAss)
done


lemma LAssRedsThrow:
  "⟦ P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟧ ⟹ P,E ⊢ ⟨ V:=e,s⟩ →* ⟨Throw r,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule LAssReds)
apply(simp add:red_reds.LAssThrow)
done


subsection ‹BinOp›

lemma BinOp1Reds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨ e «bop» e⇩₂, s⟩ →* ⟨e' «bop» e⇩₂, s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:BinOpRed1)
done


lemma BinOp2Reds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨(Val v) «bop» e, s⟩ →* ⟨(Val v) «bop» e', s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:BinOpRed2)
done


lemma BinOpRedsVal:
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ →* ⟨Val v⇩₁,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ →* ⟨Val v⇩₂,s⇩₂⟩; 
     binop(bop,v⇩₁,v⇩₂) = Some v ⟧
  ⟹ P,E ⊢ ⟨e⇩₁ «bop» e⇩₂, s⇩₀⟩ →* ⟨Val v,s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
 apply(erule BinOp2Reds)
apply(simp add:RedBinOp)
done


lemma BinOpRedsThrow1:
  "P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e «bop» e⇩₂, s⟩ →* ⟨Throw r, s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule BinOp1Reds)
apply(simp add:red_reds.BinOpThrow1)
done


lemma BinOpRedsThrow2:
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ →* ⟨Val v⇩₁,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ →* ⟨Throw r,s⇩₂⟩⟧
  ⟹ P,E ⊢ ⟨e⇩₁ «bop» e⇩₂, s⇩₀⟩ →* ⟨Throw r,s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule BinOp1Reds)
apply(rule rtrancl_into_rtrancl)
 apply(erule BinOp2Reds)
apply(simp add:red_reds.BinOpThrow2)
done


subsection ‹FAcc›

lemma FAccReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs}, s⟩ →* ⟨e'∙F{Cs}, s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:FAccRed)
done


lemma FAccRedsVal:
  "⟦P,E ⊢ ⟨e,s⟩ →* ⟨ref(a,Cs'),s'⟩; hp s' a = Some(D,S); 
    Ds = Cs'@⇩_pCs; (Ds,fs) ∈ S; fs F = Some v ⟧
  ⟹ P,E ⊢ ⟨e∙F{Cs},s⟩ →* ⟨Val v,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply (fastforce intro:RedFAcc)
done


lemma FAccRedsNull:
  "P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs},s⟩ →* ⟨THROW NullPointer,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(simp add:RedFAccNull)
done


lemma FAccRedsThrow:
  "P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs},s⟩ →* ⟨Throw r,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule FAccReds)
apply(simp add:red_reds.FAccThrow)
done


subsection ‹FAss›

lemma FAssReds1:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs}:=e⇩₂, s⟩ →* ⟨e'∙F{Cs}:=e⇩₂, s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:FAssRed1)
done


lemma FAssReds2:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨Val v∙F{Cs}:=e, s⟩ →* ⟨Val v∙F{Cs}:=e', s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:FAssRed2)
done


lemma FAssRedsVal:
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ →* ⟨ref(a,Cs'),s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ →* ⟨Val v,(h⇩₂,l⇩₂)⟩; 
    h⇩₂ a = Some(D,S); P ⊢ (last Cs') has least F:T via Cs; P ⊢ T casts v to v';
    Ds = Cs'@⇩_pCs; (Ds,fs) ∈ S ⟧ ⟹
  P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂, s⇩₀⟩ →* 
        ⟨Val v',(h⇩₂(a↦(D,insert (Ds,fs(F↦v')) (S - {(Ds,fs)}))),l⇩₂)⟩"

apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(fastforce intro:RedFAss)
done


lemma FAssRedsNull:
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ →* ⟨null,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ →* ⟨Val v,s⇩₂⟩ ⟧ ⟹
  P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂, s⇩₀⟩ →* ⟨THROW NullPointer, s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(simp add:RedFAssNull)
done


lemma FAssRedsThrow1:
  "P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e∙F{Cs}:=e⇩₂, s⟩ →* ⟨Throw r, s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds1)
apply(simp add:red_reds.FAssThrow1)
done


lemma FAssRedsThrow2:
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ →* ⟨Val v,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ →* ⟨Throw r,s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂,s⇩₀⟩ →* ⟨Throw r,s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule FAssReds1)
apply(rule rtrancl_into_rtrancl)
 apply(erule FAssReds2)
apply(simp add:red_reds.FAssThrow2)
done


subsection ‹;;›

lemma  SeqReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e;;e⇩₂, s⟩ →* ⟨e';;e⇩₂, s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:SeqRed)
done


lemma SeqRedsThrow:
  "P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨e;;e⇩₂, s⟩ →* ⟨Throw r, s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule SeqReds)
apply(simp add:red_reds.SeqThrow)
done


lemma SeqReds2:
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ →* ⟨Val v⇩₁,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ →* ⟨e⇩₂',s⇩₂⟩ ⟧ ⟹ P,E ⊢ ⟨e⇩₁;;e⇩₂, s⇩₀⟩ →* ⟨e⇩₂',s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule SeqReds)
apply(rule_tac b="(e⇩₂,s⇩₁)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedSeq)
apply assumption
done



subsection ‹If›

lemma CondReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂,s⟩ →* ⟨if (e') e⇩₁ else e⇩₂,s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:CondRed)
done


lemma CondRedsThrow:
  "P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂, s⟩ →* ⟨Throw r,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule CondReds)
apply(simp add:red_reds.CondThrow)
done


lemma CondReds2T:
  "⟦P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨true,s⇩₁⟩; P,E ⊢ ⟨e⇩₁, s⇩₁⟩ →* ⟨e',s⇩₂⟩ ⟧ ⟹ P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂, s⇩₀⟩ →* ⟨e',s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule_tac b="(e⇩₁, s⇩₁)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedCondT)
apply assumption
done


lemma CondReds2F:
  "⟦P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨false,s⇩₁⟩; P,E ⊢ ⟨e⇩₂, s⇩₁⟩ →* ⟨e',s⇩₂⟩ ⟧ ⟹ P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂, s⇩₀⟩ →* ⟨e',s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule_tac b="(e⇩₂, s⇩₁)" in  converse_rtrancl_into_rtrancl)
 apply(simp add:RedCondF)
apply assumption
done



subsection ‹While›

lemma WhileFReds:
  "P,E ⊢ ⟨b,s⟩ →* ⟨false,s'⟩ ⟹ P,E ⊢ ⟨while (b) c,s⟩ →* ⟨unit,s'⟩"

apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedWhile)
apply(rule rtrancl_into_rtrancl)
 apply(erule CondReds)
apply(simp add:RedCondF)
done


lemma WhileRedsThrow:
  "P,E ⊢ ⟨b,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨while (b) c,s⟩ →* ⟨Throw r,s'⟩"

apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedWhile)
apply(rule rtrancl_into_rtrancl)
 apply(erule CondReds)
apply(simp add:red_reds.CondThrow)
done


lemma WhileTReds:
  "⟦ P,E ⊢ ⟨b,s⇩₀⟩ →* ⟨true,s⇩₁⟩; P,E ⊢ ⟨c,s⇩₁⟩ →* ⟨Val v⇩₁,s⇩₂⟩; P,E ⊢ ⟨while (b) c,s⇩₂⟩ →* ⟨e,s⇩₃⟩ ⟧
  ⟹ P,E ⊢ ⟨while (b) c,s⇩₀⟩ →* ⟨e,s⇩₃⟩"

apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s⇩₀)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedWhile)
apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule_tac b="(c;;while(b) c,s⇩₁)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedCondT)
apply(rule rtrancl_trans)
 apply(erule SeqReds)
apply(rule_tac b="(while(b) c,s⇩₂)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedSeq)
apply assumption
done


lemma WhileTRedsThrow:
  "⟦ P,E ⊢ ⟨b,s⇩₀⟩ →* ⟨true,s⇩₁⟩; P,E ⊢ ⟨c,s⇩₁⟩ →* ⟨Throw r,s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨while (b) c,s⇩₀⟩ →* ⟨Throw r,s⇩₂⟩"

apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s⇩₀)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedWhile)
apply(rule rtrancl_trans)
 apply(erule CondReds)
apply(rule_tac b="(c;;while(b) c,s⇩₁)" in converse_rtrancl_into_rtrancl)
 apply(simp add:RedCondT)
apply(rule rtrancl_trans)
 apply(erule SeqReds)
apply(rule_tac b="(Throw r,s⇩₂)" in converse_rtrancl_into_rtrancl)
 apply(simp add:red_reds.SeqThrow)
apply simp
done


subsection ‹Throw›

lemma ThrowReds:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨throw e,s⟩ →* ⟨throw e',s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:ThrowRed)
done


lemma ThrowRedsNull:
  "P,E ⊢ ⟨e,s⟩ →* ⟨null,s'⟩ ⟹ P,E ⊢ ⟨throw e,s⟩ →* ⟨THROW NullPointer,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule ThrowReds)
apply(simp add:RedThrowNull)
done


lemma ThrowRedsThrow:
  "P,E ⊢ ⟨e,s⟩ →* ⟨Throw r,s'⟩ ⟹ P,E ⊢ ⟨throw e,s⟩ →* ⟨Throw r,s'⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule ThrowReds)
apply(simp add:red_reds.ThrowThrow)
done


subsection ‹InitBlock›

lemma assumes wf:"wf_prog wf_md P"
shows InitBlockReds_aux:
"P,E(V ↦ T) ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹
  ∀h l h' l' v v'. s = (h,l(V↦v')) ⟶ 
                   P ⊢ T casts v to v' ⟶ s' = (h',l') ⟶
                   (∃v'' w. P,E ⊢ ⟨{V:T := Val v; e},(h,l)⟩ →* 
                                ⟨{V:T := Val v''; e'},(h',l'(V:=(l V)))⟩ ∧
                            P ⊢ T casts v'' to w)"
proof (erule converse_rtrancl_induct2)
  { fix h l h' l' v v'
    assume "s' = (h, l(V ↦ v'))" and "s' = (h', l')"
    hence h:"h = h'" and l':"l' = l(V ↦ v')" by simp_all
    hence "P,E ⊢ ⟨{V:T; V:=Val v;; e'},(h, l)⟩ →*
                 ⟨{V:T; V:=Val v;; e'},(h', l'(V := l V))⟩"
      by(fastforce simp: fun_upd_same simp del:fun_upd_apply) }
  hence "∀h l h' l' v v'.
         s' = (h, l(V ↦ v')) ⟶
           P ⊢ T casts v to v'  ⟶
             s' = (h', l') ⟶
               P,E ⊢ ⟨{V:T; V:=Val v;; e'},(h, l)⟩ →*
                     ⟨{V:T; V:=Val v;; e'},(h', l'(V := l V))⟩ ∧
               P ⊢ T casts v to v'"
    by auto
  thus "∀h l h' l' v v'.
       s' = (h, l(V ↦ v')) ⟶
         P ⊢ T casts v to v'  ⟶
           s' = (h', l') ⟶
             (∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e'},(h, l)⟩ →*
                            ⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
                      P ⊢ T casts v'' to w)"
    by auto
next
  fix e s e'' s''
  assume Red:"((e,s),e'',s'') ∈ Red P (E(V ↦ T))"
    and reds:"P,E(V ↦ T) ⊢ ⟨e'',s''⟩ →* ⟨e',s'⟩"
    and IH:"∀h l h' l' v v'.
           s'' = (h, l(V ↦ v')) ⟶
             P ⊢ T casts v to v'  ⟶
               s' = (h', l') ⟶
                 (∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e''},(h, l)⟩ →*
                                ⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
                          P ⊢ T casts v'' to w)"
  { fix h l h' l' v v'
    assume s:"s = (h, l(V ↦ v'))" and s':"s' = (h', l')"
      and casts:"P ⊢ T casts v to v'"
    obtain h'' l'' where s'':"s'' = (h'',l'')" by (cases s'') auto
    with Red s have "V ∈ dom l''" by (fastforce dest:red_lcl_incr)
    then obtain v'' where l'':"l'' V = Some v''" by auto
    with Red s s'' casts
    have step:"P,E ⊢ ⟨{V:T := Val v; e},(h, l)⟩ →  
              ⟨{V:T := Val v''; e''}, (h'',l''(V := l V))⟩"
      by(fastforce intro:InitBlockRed)
    from Red s s'' l'' casts wf
    have casts':"P ⊢ T casts v'' to v''" by(fastforce intro:Some_lcl_casts_values)
    with IH s'' s' l'' obtain v''' w
      where "P,E ⊢ ⟨{V:T := Val v''; e''}, (h'',l''(V := l V))⟩ →*
                   ⟨{V:T := Val v'''; e'},(h', l'(V := l V))⟩ ∧
             P ⊢ T casts v''' to w"
      apply simp
      apply (erule_tac x = "l''(V := l V)" in allE)
      apply (erule_tac x = "v''" in allE)
      apply (erule_tac x = "v''" in allE)
      by(auto intro:ext)
    with step have "∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e},(h, l)⟩ →*
                                   ⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
                            P ⊢ T casts v'' to w"
      apply(rule_tac x="v'''" in exI)
      apply auto
       apply (rule converse_rtrancl_into_rtrancl)
      by simp_all }
  thus "∀h l h' l' v v'.
             s = (h, l(V ↦ v')) ⟶
             P ⊢ T casts v to v'  ⟶
             s' = (h', l') ⟶
             (∃v'' w. P,E ⊢ ⟨{V:T; V:=Val v;; e},(h, l)⟩ →*
                            ⟨{V:T; V:=Val v'';; e'},(h', l'(V := l V))⟩ ∧
                      P ⊢ T casts v'' to w)"
    by auto
qed



lemma InitBlockReds:
 "⟦P,E(V ↦ T) ⊢ ⟨e, (h,l(V↦v'))⟩ →* ⟨e', (h',l')⟩; 
   P ⊢ T casts v to v'; wf_prog wf_md P ⟧ ⟹
  ∃v'' w. P,E ⊢ ⟨{V:T := Val v; e}, (h,l)⟩ →* 
              ⟨{V:T := Val v''; e'}, (h',l'(V:=(l V)))⟩ ∧
          P ⊢ T casts v'' to w"
by(blast dest:InitBlockReds_aux)

lemma InitBlockRedsFinal:
  assumes reds:"P,E(V ↦ T) ⊢ ⟨e,(h,l(V↦v'))⟩ →* ⟨e',(h',l')⟩"
  and final:"final e'" and casts:"P ⊢ T casts v to v'"
  and wf:"wf_prog wf_md P"
  shows "P,E ⊢ ⟨{V:T := Val v; e},(h,l)⟩ →* ⟨e',(h', l'(V := l V))⟩"
proof -
  from reds casts wf obtain v'' and w
    where steps:"P,E ⊢ ⟨{V:T := Val v; e},(h,l)⟩ →* 
                        ⟨{V:T := Val v''; e'}, (h',l'(V:=(l V)))⟩"
    and casts':"P ⊢ T casts v'' to w"
    by (auto dest:InitBlockReds)
  from final casts casts'
  have step:"P,E ⊢ ⟨{V:T := Val v''; e'}, (h',l'(V:=(l V)))⟩ →
                    ⟨e',(h',l'(V := l V))⟩"
    by(auto elim!:finalE intro:RedInitBlock InitBlockThrow)
  from step steps show ?thesis
    by(fastforce intro:rtrancl_into_rtrancl)
qed



subsection ‹Block›

lemma BlockRedsFinal:
assumes reds: "P,E(V ↦ T) ⊢ ⟨e⇩₀,s⇩₀⟩ →* ⟨e⇩₂,(h⇩₂,l⇩₂)⟩" and fin: "final e⇩₂"
  and wf:"wf_prog wf_md P"
shows "⋀h⇩₀ l⇩₀. s⇩₀ = (h⇩₀,l⇩₀(V:=None)) ⟹ P,E ⊢ ⟨{V:T; e⇩₀},(h⇩₀,l⇩₀)⟩ →* ⟨e⇩₂,(h⇩₂,l⇩₂(V:=l⇩₀ V))⟩"

using reds
proof (induct rule:converse_rtrancl_induct2)
  case refl thus ?case
    by(fastforce intro:finalE[OF fin] RedBlock BlockThrow
                simp del:fun_upd_apply)
next
  case (step e⇩₀ s⇩₀ e⇩₁ s⇩₁)
  have Red: "((e⇩₀,s⇩₀),e⇩₁,s⇩₁) ∈ Red P (E(V ↦ T))"
   and reds: "P,E(V ↦ T) ⊢ ⟨e⇩₁,s⇩₁⟩ →* ⟨e⇩₂,(h⇩₂,l⇩₂)⟩"
   and IH: "⋀h l. s⇩₁ = (h,l(V := None))
                ⟹ P,E ⊢ ⟨{V:T; e⇩₁},(h,l)⟩ →* ⟨e⇩₂,(h⇩₂, l⇩₂(V := l V))⟩"
   and s⇩₀: "s⇩₀ = (h⇩₀, l⇩₀(V := None))" by fact+
  obtain h⇩₁ l⇩₁ where s⇩₁: "s⇩₁ = (h⇩₁,l⇩₁)" by fastforce
  show ?case
  proof cases
    assume "assigned V e⇩₀"
    then obtain v e where e⇩₀: "e⇩₀ = V:= Val v;; e"
      by (unfold assigned_def)blast
    from Red e⇩₀ s⇩₀ obtain v' where e⇩₁: "e⇩₁ = Val v';;e" 
      and s⇩₁: "s⇩₁ = (h⇩₀, l⇩₀(V ↦ v'))" and casts:"P ⊢ T casts v to v'"
      by auto
    from e⇩₁ fin have "e⇩₁ ≠ e⇩₂" by (auto simp:final_def)
    then obtain e' s' where red1: "P,E(V ↦ T) ⊢ ⟨e⇩₁,s⇩₁⟩ → ⟨e',s'⟩"
      and reds': "P,E(V ↦ T) ⊢ ⟨e',s'⟩ →* ⟨e⇩₂,(h⇩₂,l⇩₂)⟩"
      using converse_rtranclE2[OF reds] by simp blast
    from red1 e⇩₁ have es': "e' = e" "s' = s⇩₁" by auto
    show ?thesis using e⇩₀ s⇩₁ es' reds'
        by(fastforce intro!: InitBlockRedsFinal[OF _ fin casts wf] 
                    simp del:fun_upd_apply)
  next
    assume unass: "¬ assigned V e⇩₀"
    show ?thesis
    proof (cases "l⇩₁ V")
      assume None: "l⇩₁ V = None"
      hence "P,E ⊢ ⟨{V:T; e⇩₀},(h⇩₀,l⇩₀)⟩ → ⟨{V:T; e⇩₁},(h⇩₁, l⇩₁(V := l⇩₀ V))⟩"
        using s⇩₀ s⇩₁ Red by(simp add: BlockRedNone[OF _ _ unass])
      moreover
      have "P,E ⊢ ⟨{V:T; e⇩₁},(h⇩₁, l⇩₁(V := l⇩₀ V))⟩ →* ⟨e⇩₂,(h⇩₂, l⇩₂(V := l⇩₀ V))⟩"
        using IH[of _ "l⇩₁(V := l⇩₀ V)"] s⇩₁ None by(simp add:fun_upd_idem)
      ultimately show ?case
        by(rule_tac b="({V:T; e⇩₁},(h⇩₁, l⇩₁(V := l⇩₀ V)))" in converse_rtrancl_into_rtrancl,simp)
    next
      fix v assume Some: "l⇩₁ V = Some v"
      with Red Some s⇩₀ s⇩₁ wf
      have casts:"P ⊢ T casts v to v"
        by(fastforce intro:None_lcl_casts_values)
      from Some
      have "P,E ⊢ ⟨{V:T;e⇩₀},(h⇩₀,l⇩₀)⟩ → ⟨{V:T := Val v; e⇩₁},(h⇩₁,l⇩₁(V := l⇩₀ V))⟩"
        using s⇩₀ s⇩₁ Red by(simp add: BlockRedSome[OF _ _ unass])
      moreover
      have "P,E ⊢ ⟨{V:T := Val v; e⇩₁},(h⇩₁,l⇩₁(V:= l⇩₀ V))⟩ →*
                ⟨e⇩₂,(h⇩₂,l⇩₂(V:=l⇩₀ V))⟩"
        using InitBlockRedsFinal[OF _ fin casts wf,of _ _ "l⇩₁(V:=l⇩₀ V)" V] 
          Some reds s⇩₁
        by (simp add:fun_upd_idem)
      ultimately show ?case 
        by(rule_tac b="({V:T; V:=Val v;; e⇩₁},(h⇩₁, l⇩₁(V := l⇩₀ V)))" in converse_rtrancl_into_rtrancl,simp)
    qed
  qed
qed




subsection ‹List›

lemma ListReds1:
  "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e#es,s⟩ [→]* ⟨e' # es,s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:ListRed1)
done


lemma ListReds2:
  "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ⟹ P,E ⊢ ⟨Val v # es,s⟩ [→]* ⟨Val v # es',s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:ListRed2)
done


lemma ListRedsVal:
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨Val v,s⇩₁⟩; P,E ⊢ ⟨es,s⇩₁⟩ [→]* ⟨es',s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨e#es,s⇩₀⟩ [→]* ⟨Val v # es',s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule ListReds1)
apply(erule ListReds2)
done


subsection ‹Call›

text‹First a few lemmas on what happens to free variables during redction.›


lemma assumes wf: "wwf_prog P"
shows Red_fv: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ fv e' ⊆ fv e"
  and  "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ fvs es' ⊆ fvs es"
proof (induct rule:red_reds_inducts)
  case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs' vs bs new_body E)
  hence "fv body ⊆ {this} ∪ set pns"
    using assms by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)
  with RedCall.hyps show ?case
    by(cases T') auto
next
  case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a a' b)
  hence "fv body ⊆ {this} ∪ set pns"
    using assms by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)
  with RedStaticCall.hyps show ?case
    by auto
qed auto



lemma Red_dom_lcl:
  "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ dom l' ⊆ dom l ∪ fv e" and
  "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ dom l' ⊆ dom l ∪ fvs es"

proof (induct rule:red_reds_inducts)
  case RedLAss thus ?case by(force split:if_splits)
next
  case CallParams thus ?case by(force split:if_splits)
next
  case BlockRedNone thus ?case by clarsimp (fastforce split:if_splits)
next
  case BlockRedSome thus ?case by clarsimp (fastforce split:if_splits)
next
  case InitBlockRed thus ?case by clarsimp (fastforce split:if_splits)
qed auto



lemma Reds_dom_lcl:
  "⟦ wwf_prog P; P,E ⊢ ⟨e,(h,l)⟩ →* ⟨e',(h',l')⟩ ⟧ ⟹ dom l' ⊆ dom l ∪ fv e"

apply(erule converse_rtrancl_induct_red)
 apply blast
apply(blast dest: Red_fv Red_dom_lcl)
done


text‹Now a few lemmas on the behaviour of blocks during reduction.›


lemma override_on_upd_lemma:
  "(override_on f (g(a↦b)) A)(a := g a) = override_on f g (insert a A)"

apply(rule ext)
apply(simp add:override_on_def)
done

declare fun_upd_apply[simp del] map_upds_twist[simp del]




lemma assumes wf:"wf_prog wf_md P"
  shows blocksReds:
  "⋀l⇩₀ E vs'. ⟦ length Vs = length Ts; length vs = length Ts; 
        distinct Vs; ⌦‹∀T∈set Ts. is_type P T;› P ⊢ Ts Casts vs to vs';
        P,E(Vs [↦] Ts) ⊢ ⟨e, (h⇩₀,l⇩₀(Vs [↦] vs'))⟩ →* ⟨e', (h⇩₁,l⇩₁)⟩ ⟧
  ⟹ ∃vs''. P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h⇩₀,l⇩₀)⟩ →* 
                   ⟨blocks(Vs,Ts,vs'',e'), (h⇩₁,override_on l⇩₁ l⇩₀ (set Vs))⟩ ∧ 
             (∃ws. P ⊢ Ts Casts vs'' to ws) ∧ length vs = length vs''"

proof(induct Vs Ts vs e rule:blocks_old_induct)
  case (5 V Vs T Ts v vs e)
  have length1:"length (V#Vs) = length (T#Ts)"
    and length2:"length (v#vs) = length (T#Ts)"
    and dist:"distinct (V#Vs)"
    and casts:"P ⊢ (T#Ts) Casts (v#vs) to vs'"
    and reds:"P,E(V#Vs [↦] T#Ts) ⊢ ⟨e,(h⇩₀,l⇩₀(V#Vs [↦] vs'))⟩ →* ⟨e',(h⇩₁,l⇩₁)⟩"
    and IH:"⋀l⇩₀ E vs''. ⟦length Vs = length Ts; length vs = length Ts; 
       distinct Vs; P ⊢ Ts Casts vs to vs'';
       P,E(Vs [↦] Ts) ⊢ ⟨e,(h⇩₀,l⇩₀(Vs [↦] vs''))⟩ →* ⟨e',(h⇩₁,l⇩₁)⟩⟧
        ⟹ ∃vs''. P,E ⊢ ⟨blocks (Vs,Ts,vs,e),(h⇩₀,l⇩₀)⟩ →*
                         ⟨blocks (Vs,Ts,vs'',e'),(h⇩₁, override_on l⇩₁ l⇩₀ (set Vs))⟩ ∧
                   (∃ws. P ⊢ Ts Casts vs'' to ws) ∧ length vs = length vs''" by fact+
  from length1 have length1':"length Vs = length Ts" by simp
  from length2 have length2':"length vs = length Ts" by simp
  from dist have dist':"distinct Vs" by simp
  from casts obtain x xs where vs':"vs' = x#xs"
    by(cases vs',auto dest:length_Casts_vs')
  with reds
  have reds':"P,E(V ↦ T)(Vs [↦] Ts) ⊢ ⟨e,(h⇩₀,l⇩₀(V ↦ x)(Vs [↦] xs))⟩ 
                                    →* ⟨e',(h⇩₁,l⇩₁)⟩"
    by simp
  from casts vs' have casts':"P ⊢ Ts Casts vs to xs" 
    and cast':"P ⊢ T casts v to x"
    by(auto elim:Casts_to.cases)
  from IH[OF length1' length2' dist' casts' reds']
  obtain vs'' ws
    where blocks:"P,E(V ↦ T) ⊢ ⟨blocks (Vs, Ts, vs, e),(h⇩₀, l⇩₀(V ↦ x))⟩ →*
             ⟨blocks (Vs, Ts, vs'', e'),(h⇩₁, override_on l⇩₁ (l⇩₀(V ↦ x)) (set Vs))⟩"
    and castsws:"P ⊢ Ts Casts vs'' to ws"
    and lengthvs'':"length vs = length vs''" by auto
  from InitBlockReds[OF blocks cast' wf] obtain v'' w where
    blocks':"P,E ⊢ ⟨{V:T; V:=Val v;; blocks (Vs, Ts, vs, e)},(h⇩₀, l⇩₀)⟩ →*
                   ⟨{V:T; V:=Val v'';; blocks (Vs, Ts, vs'', e')},
                    (h⇩₁, (override_on l⇩₁ (l⇩₀(V ↦ x)) (set Vs))(V := l⇩₀ V))⟩"
    and "P ⊢ T casts v'' to w" by auto
  with castsws have "P ⊢ T#Ts Casts v''#vs'' to w#ws"
    by -(rule Casts_Cons)
  with blocks' lengthvs'' show ?case
    by(rule_tac x="v''#vs''" in exI,auto simp:override_on_upd_lemma)
next
  case (6 e)
  have casts:"P ⊢ [] Casts [] to vs'" 
    and step:"P,E([] [↦] []) ⊢ ⟨e,(h⇩₀, l⇩₀([] [↦] vs'))⟩ →* ⟨e',(h⇩₁, l⇩₁)⟩" by fact+
  from casts have "vs' = []" by(fastforce dest:length_Casts_vs')
  with step have "P,E ⊢ ⟨e,(h⇩₀, l⇩₀)⟩ →* ⟨e',(h⇩₁, l⇩₁)⟩" by simp
  with casts show ?case by auto
qed simp_all



lemma assumes wf:"wf_prog wf_md P"
  shows blocksFinal:
 "⋀E l vs'. ⟦ length Vs = length Ts; length vs = length Ts;
           ⌦‹∀T∈set Ts. is_type P T;› final e; P ⊢ Ts Casts vs to vs' ⟧ ⟹
       P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h,l)⟩ →* ⟨e, (h,l)⟩"

proof(induct Vs Ts vs e rule:blocks_old_induct)
  case (5 V Vs T Ts v vs e)
  have length1:"length (V # Vs) = length (T # Ts)"
    and length2:"length (v # vs) = length (T # Ts)"
    and final:"final e" and casts:"P ⊢ T # Ts Casts v # vs to vs'"
    and IH:"⋀E l vs'. ⟦length Vs = length Ts; length vs = length Ts; final e;
                   P ⊢ Ts Casts vs to vs' ⟧
                  ⟹ P,E ⊢ ⟨blocks (Vs, Ts, vs, e),(h, l)⟩ →* ⟨e,(h, l)⟩" by fact+
  from length1 length2
  have length1':"length Vs = length Ts" and length2':"length vs = length Ts"
    by simp_all
  from casts obtain x xs where vs':"vs' = x#xs"
    by(cases vs',auto dest:length_Casts_vs')
  with casts have casts':"P ⊢ Ts Casts vs to xs" 
    and cast':"P ⊢ T casts v to x"
    by(auto elim:Casts_to.cases)
  from InitBlockReds[OF IH[OF length1' length2' final casts'] cast' wf, of V l]
  obtain v'' w
    where blocks:"P,E ⊢ ⟨{V:T; V:=Val v;; blocks (Vs, Ts, vs, e)},(h, l)⟩ →*
                        ⟨{V:T; V:=Val v'';; e},(h,l)⟩"
    and "P ⊢ T casts v'' to w" by auto blast
  with final have "P,E ⊢ ⟨{V:T; V:=Val v'';; e},(h,l)⟩ → ⟨e,(h,l)⟩"
    by(auto elim!:finalE intro:RedInitBlock InitBlockThrow)
  with blocks show ?case
    by -(rule_tac b="({V:T; V:=Val v'';; e},(h, l))" in rtrancl_into_rtrancl,simp_all)
qed auto



lemma assumes wfmd:"wf_prog wf_md P"
  and wf: "length Vs = length Ts" "length vs = length Ts" "distinct Vs" 
  and casts:"P ⊢ Ts Casts vs to vs'"
  and reds: "P,E(Vs [↦] Ts) ⊢ ⟨e, (h⇩₀, l⇩₀(Vs [↦] vs'))⟩ →* ⟨e', (h⇩₁, l⇩₁)⟩"
  and fin: "final e'" and l2: "l⇩₂ = override_on l⇩₁ l⇩₀ (set Vs)"
shows blocksRedsFinal: "P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h⇩₀, l⇩₀)⟩ →* ⟨e', (h⇩₁,l⇩₂)⟩"

proof -
  obtain vs'' ws where blocks:"P,E ⊢ ⟨blocks(Vs,Ts,vs,e), (h⇩₀, l⇩₀)⟩ →* 
                                  ⟨blocks(Vs,Ts,vs'',e'), (h⇩₁,l⇩₂)⟩"
    and length:"length vs = length vs''"
    and casts':"P ⊢ Ts Casts vs'' to ws"
    using l2 blocksReds[OF wfmd wf casts reds]
     by auto
   have "P,E ⊢ ⟨blocks(Vs,Ts,vs'',e'), (h⇩₁,l⇩₂)⟩ →* ⟨e', (h⇩₁,l⇩₂)⟩"
     using blocksFinal[OF wfmd _ _ fin casts'] wf length by simp
   with blocks show ?thesis by simp
qed




text‹An now the actual method call reduction lemmas.›

lemma CallRedsObj:
 "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ 
  P,E ⊢ ⟨Call e Copt M es,s⟩ →* ⟨Call e' Copt M es,s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:CallObj)
done


lemma CallRedsParams:
 "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩ ⟹ 
  P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ →* ⟨Call (Val v) Copt M es',s'⟩"

apply(erule rtrancl_induct2)
 apply blast
apply(erule rtrancl_into_rtrancl)
apply(simp add:CallParams)
done




lemma cast_lcl:
  "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩ ⟹
   P,E ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨Val v',(h,l')⟩"

apply(erule red.cases)
apply(auto intro:red_reds.intros)
apply(subgoal_tac "P,E ⊢ ⟨⦇C⦈ref (a,Cs@[C]@Cs'),(h,l')⟩ → ⟨ref (a,Cs@[C]),(h,l')⟩")
 apply simp
apply(rule RedStaticDownCast)
done


lemma cast_env:
  "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩ ⟹ 
   P,E' ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩"

apply(erule red.cases)
apply(auto intro:red_reds.intros)
apply(subgoal_tac "P,E' ⊢ ⟨⦇C⦈ref (a,Cs@[C]@Cs'),(h,l)⟩ → ⟨ref (a,Cs@[C]),(h,l)⟩")
 apply simp
apply(rule RedStaticDownCast)
done


lemma Cast_step_Cast_or_fin:
"P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨e',s'⟩ ⟹ final e' ∨ (∃e''. e' = ⦇C⦈e'')"
by(induct rule:rtrancl_induct2,auto elim:red.cases simp:final_def)

lemma Cast_red:"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ⟹ 
  (⋀e⇩₁. ⟦e = ⦇C⦈e⇩₀; e' = ⦇C⦈e⇩₁⟧ ⟹ P,E ⊢ ⟨e⇩₀,s⟩ →* ⟨e⇩₁,s'⟩)"

proof(induct rule:rtrancl_induct2)
  case refl thus ?case by simp
next
  case (step e'' s'' e' s')
  have step:"P,E ⊢ ⟨e,s⟩ →* ⟨e'',s''⟩"
    and Red:"((e'', s''), e', s') ∈ Red P E"
    and cast:"e = ⦇C⦈e⇩₀" and cast':"e' = ⦇C⦈e⇩₁"
    and IH:"⋀e⇩₁. ⟦e = ⦇C⦈e⇩₀; e'' = ⦇C⦈e⇩₁⟧ ⟹ P,E ⊢ ⟨e⇩₀,s⟩ →* ⟨e⇩₁,s''⟩" by fact+
  from Red have red:"P,E ⊢ ⟨e'',s''⟩ → ⟨e',s'⟩" by simp
  from step cast have "final e'' ∨ (∃ex. e'' = ⦇C⦈ex)"
    by simp(rule Cast_step_Cast_or_fin)
  thus ?case
  proof(rule disjE)
    assume "final e''"
    with red show ?thesis by(auto simp:final_def)
  next
    assume "∃ex. e'' = ⦇C⦈ex"
    then obtain ex where e'':"e'' = ⦇C⦈ex" by blast
    with cast' red have "P,E ⊢ ⟨ex,s''⟩ → ⟨e⇩₁,s'⟩"
      by(auto elim:red.cases)
    with  IH[OF cast e''] show ?thesis
      by(rule_tac b="(ex,s'')" in rtrancl_into_rtrancl,simp_all)
  qed
qed


lemma Cast_final:"⟦P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨e',s'⟩; final e'⟧ ⟹
∃e'' s''. P,E ⊢ ⟨e,s⟩ →* ⟨e'',s''⟩ ∧ P,E ⊢ ⟨⦇C⦈e'',s''⟩ → ⟨e',s'⟩ ∧ final e''"

proof(induct rule:rtrancl_induct2)
  case refl thus ?case by (simp add:final_def)
next
  case (step e'' s'' e' s')
  have step:"P,E ⊢ ⟨⦇C⦈e,s⟩ →* ⟨e'',s''⟩"
    and Red:"((e'', s''), e', s') ∈ Red P E"
    and final:"final e'"
    and IH:"final e'' ⟹ 
   ∃ex sx. P,E ⊢ ⟨e,s⟩ →* ⟨ex,sx⟩ ∧ P,E ⊢ ⟨⦇C⦈ex,sx⟩ → ⟨e'',s''⟩ ∧ final ex" by fact+
  from Red have red:"P,E ⊢ ⟨e'',s''⟩ → ⟨e',s'⟩" by simp
  from step have "final e'' ∨ (∃ex. e'' = ⦇C⦈ex)" by(rule Cast_step_Cast_or_fin)
  thus ?case
  proof(rule disjE)
    assume "final e''"
    with red show ?thesis by(auto simp:final_def)
  next
    assume "∃ex. e'' = ⦇C⦈ex"
    then obtain ex where e'':"e'' = ⦇C⦈ex" by blast
    with red final have final':"final ex"
      by(auto elim:red.cases simp:final_def)
    from step e'' have "P,E ⊢ ⟨e,s⟩ →* ⟨ex,s''⟩"
      by(fastforce intro:Cast_red)
    with e'' red final' show ?thesis by blast
  qed
qed


lemma Cast_final_eq:
  assumes red:"P,E ⊢ ⟨⦇C⦈e,(h,l)⟩ → ⟨e',(h,l)⟩"
  and final:"final e" and final':"final e'"
  shows "P,E' ⊢ ⟨⦇C⦈e,(h,l')⟩ → ⟨e',(h,l')⟩"

proof -
  from red final show ?thesis
  proof(auto simp:final_def)
    fix v assume "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨e',(h,l)⟩"
    with final' show "P,E' ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨e',(h,l')⟩"
    proof(auto simp:final_def)
      fix v' assume "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Val v',(h,l)⟩"
      thus "P,E' ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨Val v',(h,l')⟩"
        by(auto intro:cast_lcl cast_env)
    next
      fix a Cs assume "P,E ⊢ ⟨⦇C⦈(Val v),(h,l)⟩ → ⟨Throw (a,Cs),(h,l)⟩"
      thus "P,E' ⊢ ⟨⦇C⦈(Val v),(h,l')⟩ → ⟨Throw (a,Cs),(h,l')⟩"
        by(auto elim:red.cases intro!:RedStaticCastFail)
    qed
  next
    fix a Cs assume "P,E ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l)⟩ → ⟨e',(h,l)⟩"
    with final' show "P,E' ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l')⟩ → ⟨e',(h,l')⟩"
    proof(auto simp:final_def)
      fix v assume "P,E ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l)⟩ → ⟨Val v,(h,l)⟩"
      thus "P,E' ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l')⟩ → ⟨Val v,(h,l')⟩"
        by(auto elim:red.cases)
    next
      fix a' Cs'
      assume "P,E ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l)⟩ → ⟨Throw (a',Cs'),(h,l)⟩"
      thus "P,E' ⊢ ⟨⦇C⦈(Throw (a,Cs)),(h,l')⟩ → ⟨Throw (a',Cs'),(h,l')⟩"
        by(auto elim:red.cases intro:red_reds.StaticCastThrow)
    qed
  qed
qed



lemma CallRedsFinal:
assumes wwf: "wwf_prog P"
and "P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨ref(a,Cs),s⇩₁⟩"
      "P,E ⊢ ⟨es,s⇩₁⟩ [→]* ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
and hp: "h⇩₂ a = Some(C,S)"
and "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
and select: "P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
and size: "size vs = size pns"
and casts: "P ⊢ Ts Casts vs to vs'"
and l⇩₂': "l⇩₂' = [this ↦ Ref(a,Cs'), pns[↦]vs']"
and body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈body  | _ ⇒ body)"
and body: "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨new_body,(h⇩₂,l⇩₂')⟩ →* ⟨ef,(h⇩₃,l⇩₃)⟩"
and final:"final ef"
shows "P,E ⊢ ⟨e∙M(es), s⇩₀⟩ →* ⟨ef,(h⇩₃,l⇩₂)⟩"
proof -
  have wf: "size Ts = size pns ∧ distinct pns ∧ this ∉ set pns"
    and wt: "fv body ⊆ {this} ∪ set pns"
    using assms by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
  have "dom l⇩₃ ⊆ {this} ∪ set pns"
    using Reds_dom_lcl[OF wwf body] wt l⇩₂' set_take_subset body_case
    by (cases T') force+
  hence eql⇩₂: "override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns) = l⇩₂"
    by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
  from wwf select have "is_class P (last Cs')"
    by (auto elim!:SelectMethodDef.cases intro:Subobj_last_isClass 
             simp:LeastMethodDef_def FinalOverriderMethodDef_def 
                  OverriderMethodDefs_def MinimalMethodDefs_def MethodDefs_def)
  hence "P ⊢ Class (last Cs') casts Ref(a,Cs') to Ref(a,Cs')"
    by(auto intro!:casts_ref Subobjs_Base simp:path_via_def appendPath_def)
  with casts
  have casts':"P ⊢ Class (last Cs')#Ts Casts Ref(a,Cs')#vs to  Ref(a,Cs')#vs'"
    by -(rule Casts_Cons)
  have 1:"P,E ⊢ ⟨e∙M(es),s⇩₀⟩ →* ⟨(ref(a,Cs))∙M(es),s⇩₁⟩" by(rule CallRedsObj)(rule assms(2))
  have 2:"P,E ⊢ ⟨(ref(a,Cs))∙M(es),s⇩₁⟩ →*
                 ⟨(ref(a,Cs))∙M(map Val vs),(h⇩₂,l⇩₂)⟩"
    by(rule CallRedsParams)(rule assms(3))
  from body[THEN Red_lcl_add, of l⇩₂]
  have body': "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
             ⟨new_body,(h⇩₂,l⇩₂(this↦ Ref(a,Cs'), pns[↦]vs'))⟩ →* ⟨ef,(h⇩₃,l⇩₂++l⇩₃)⟩"
    by (simp add:l⇩₂')
  show ?thesis
  proof(cases "∀C. T'≠ Class C")
    case True
    hence "P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩₂,l⇩₂)⟩ → 
                 ⟨blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h⇩₂,l⇩₂)⟩"
      using hp "method" select size wf
      by -(rule RedCall,auto,cases T',auto)
    hence 3:"P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩₂,l⇩₂)⟩ →* 
                   ⟨blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h⇩₂,l⇩₂)⟩"
      by(simp add:r_into_rtrancl)
    have "P,E ⊢ ⟨blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body),(h⇩₂,l⇩₂)⟩ →* 
                ⟨ef,(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩"
      using True wf body' wwf size final casts' body_case
      by -(rule_tac vs'="Ref(a,Cs')#vs'" in blocksRedsFinal,simp_all,cases T',auto)
    with 1 2 3 show ?thesis using eql⇩₂
      by simp
  next
    case False
    then obtain D where T':"T' = Class D" by auto
    with final body' body_case obtain s' e' where 
      body'':"P,E(this ↦ Class (last Cs'),pns [↦] Ts) ⊢ 
                           ⟨body,(h⇩₂,l⇩₂(this↦ Ref(a,Cs'), pns[↦]vs'))⟩ →* ⟨e',s'⟩"
      and final':"final e'" 
      and cast:"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨⦇D⦈e',s'⟩ → 
                                                           ⟨ef,(h⇩₃,l⇩₂++l⇩₃)⟩"
      by(cases T')(auto dest:Cast_final)
    from T' have "P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩₂,l⇩₂)⟩ → 
                 ⟨⦇D⦈blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h⇩₂,l⇩₂)⟩"
      using hp "method" select size wf
      by -(rule RedCall,auto)
    hence 3:"P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs), (h⇩₂,l⇩₂)⟩ →* 
                  ⟨⦇D⦈blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body),(h⇩₂,l⇩₂)⟩"
      by(simp add:r_into_rtrancl)
    from cast final have eq:"s' = (h⇩₃,l⇩₂++l⇩₃)"
      by(auto elim:red.cases simp:final_def)
    hence "P,E ⊢ ⟨blocks(this#pns, Class (last Cs')#Ts, Ref(a,Cs')#vs,body), (h⇩₂,l⇩₂)⟩
                 →* ⟨e',(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩"
      using wf body'' wwf size final' casts'
      by -(rule_tac vs'="Ref(a,Cs')#vs'" in blocksRedsFinal,simp_all)
    hence "P,E ⊢ ⟨⦇D⦈(blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)),(h⇩₂,l⇩₂)⟩
             →* ⟨⦇D⦈e',(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩"
      by(rule StaticCastReds)
    moreover
    have "P,E ⊢ ⟨⦇D⦈e',(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩ → 
                ⟨ef,(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩"
      using eq cast final final'
      by(fastforce intro:Cast_final_eq)
    ultimately
    have "P,E ⊢ ⟨⦇D⦈(blocks(this#pns, Class (last Cs')#Ts, Ref(a,Cs')#vs,body)), 
                  (h⇩₂,l⇩₂)⟩ →* ⟨ef,(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩"
      by(rule_tac b="(⦇D⦈e',(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns)))"
        in rtrancl_into_rtrancl,simp_all)
    with 1 2 3 show ?thesis using eql⇩₂
      by simp
  qed
qed


lemma StaticCallRedsFinal:
assumes wwf: "wwf_prog P"
and "P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨ref(a,Cs),s⇩₁⟩"
      "P,E ⊢ ⟨es,s⇩₁⟩ [→]* ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
and path_unique: "P ⊢ Path (last Cs) to C unique"
and path_via: "P ⊢ Path (last Cs) to C via Cs''" 
and Ds: "Ds = (Cs@⇩_pCs'')@⇩_pCs'"
and least: "P ⊢ C has least M = (Ts,T,pns,body) via Cs'"
and size: "size vs = size pns"
and casts: "P ⊢ Ts Casts vs to vs'"
and l⇩₂': "l⇩₂' = [this ↦ Ref(a,Ds), pns[↦]vs']"
and body: "P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ ⟨body,(h⇩₂,l⇩₂')⟩ →* ⟨ef,(h⇩₃,l⇩₃)⟩"
and final:"final ef"
shows "P,E ⊢ ⟨e∙(C::)M(es), s⇩₀⟩ →* ⟨ef,(h⇩₃,l⇩₂)⟩"
proof -
  have wf: "size Ts = size pns ∧ distinct pns ∧ this ∉ set pns ∧ 
            (∀T∈set Ts. is_type P T)"
    and wt: "fv body ⊆ {this} ∪ set pns"
    using assms by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
  have "dom l⇩₃ ⊆ {this} ∪ set pns"
    using Reds_dom_lcl[OF wwf body] wt l⇩₂' set_take_subset
    by force
  hence eql⇩₂: "override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns) = l⇩₂"
    by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
  from wwf least have "Cs' ≠ []"
    by (auto elim!:Subobjs_nonempty simp:LeastMethodDef_def MethodDefs_def)
  with Ds have "last Cs' = last Ds" by(fastforce intro:appendPath_last)
  with wwf least have "is_class P (last Ds)"
    by(auto dest:Subobj_last_isClass simp:LeastMethodDef_def MethodDefs_def)
  hence "P ⊢ Class (last Ds) casts Ref(a,Ds) to Ref(a,Ds)"
    by(auto intro!:casts_ref Subobjs_Base simp:path_via_def appendPath_def)
  with casts
  have casts':"P ⊢ Class (last Ds)#Ts Casts Ref(a,Ds)#vs to Ref(a,Ds)#vs'"
    by -(rule Casts_Cons)
  have 1:"P,E ⊢ ⟨e∙(C::)M(es),s⇩₀⟩ →* ⟨(ref(a,Cs))∙(C::)M(es),s⇩₁⟩"
    by(rule CallRedsObj)(rule assms(2))
  have 2:"P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(es),s⇩₁⟩ →*
                 ⟨(ref(a,Cs))∙(C::)M(map Val vs),(h⇩₂,l⇩₂)⟩"
    by(rule CallRedsParams)(rule assms(3))
  from body[THEN Red_lcl_add, of l⇩₂]
  have body': "P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ 
              ⟨body,(h⇩₂,l⇩₂(this↦ Ref(a,Ds), pns[↦]vs'))⟩ →* ⟨ef,(h⇩₃,l⇩₂++l⇩₃)⟩"
    by (simp add:l⇩₂')
  have "P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(map Val vs), (h⇩₂,l⇩₂)⟩ →
              ⟨blocks(this#pns, Class (last Ds)#Ts, Ref(a,Ds)#vs, body), (h⇩₂,l⇩₂)⟩"
    using path_unique path_via least size wf Ds
    by -(rule RedStaticCall,auto)
  hence 3:"P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(map Val vs), (h⇩₂,l⇩₂)⟩ →* 
                   ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body), (h⇩₂,l⇩₂)⟩"
    by(simp add:r_into_rtrancl)
  have "P,E ⊢ ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),(h⇩₂,l⇩₂)⟩ →* 
                ⟨ef,(h⇩₃,override_on (l⇩₂++l⇩₃) l⇩₂ ({this} ∪ set pns))⟩"
    using wf body' wwf size final casts'
    by -(rule_tac vs'="Ref(a,Ds)#vs'" in blocksRedsFinal,simp_all)
  with 1 2 3 show ?thesis using eql⇩₂
    by simp
qed



lemma CallRedsThrowParams:
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨Val v,s⇩₁⟩;  
    P,E ⊢ ⟨es,s⇩₁⟩ [→]* ⟨map Val vs⇩₁ @ Throw ex # es⇩₂,s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ →* ⟨Throw ex,s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsParams)
apply(simp add:CallThrowParams)
done



lemma CallRedsThrowObj:
  "P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨Throw ex,s⇩₁⟩ ⟹ P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ →* ⟨Throw ex,s⇩₁⟩"

apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsObj)
apply(simp add:CallThrowObj)
done



lemma CallRedsNull:
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨null,s⇩₁⟩; P,E ⊢ ⟨es,s⇩₁⟩ [→]* ⟨map Val vs,s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ →* ⟨THROW NullPointer,s⇩₂⟩"

apply(rule rtrancl_trans)
 apply(erule CallRedsObj)
apply(rule rtrancl_into_rtrancl)
 apply(erule CallRedsParams)
apply(simp add:RedCallNull)
done



subsection ‹The main Theorem›

lemma assumes wwf: "wwf_prog P"
shows big_by_small: "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
and bigs_by_smalls: "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩ ⟹ P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"

proof (induct rule: eval_evals.inducts)
  case New thus ?case by (auto simp:RedNew)
next
  case NewFail thus ?case by (auto simp:RedNewFail)
next
  case StaticUpCast thus ?case by(simp add:StaticUpCastReds)
next
  case StaticDownCast thus ?case by(simp add:StaticDownCastReds)
next
  case StaticCastNull thus ?case by(simp add:StaticCastRedsNull)
next
  case StaticCastFail thus ?case by(simp add:StaticCastRedsFail)
next
  case StaticCastThrow thus ?case by(auto dest!:eval_final simp:StaticCastRedsThrow)
next
  case StaticUpDynCast thus ?case by(simp add:StaticUpDynCastReds)
next
  case StaticDownDynCast thus ?case by(simp add:StaticDownDynCastReds)
next
  case DynCast thus ?case by(fastforce intro:DynCastRedsRef)
next
  case DynCastNull thus ?case by(simp add:DynCastRedsNull)
next
  case DynCastFail thus ?case by(fastforce intro!:DynCastRedsFail)
next
  case DynCastThrow thus ?case by(auto dest!:eval_final simp:DynCastRedsThrow)
next
  case Val thus ?case by simp
next
  case BinOp thus ?case by(fastforce simp:BinOpRedsVal)
next
  case BinOpThrow1 thus ?case by(fastforce dest!:eval_final simp: BinOpRedsThrow1)
next
  case BinOpThrow2 thus ?case by(fastforce dest!:eval_final simp: BinOpRedsThrow2)
next
  case Var thus ?case by (fastforce simp:RedVar)
next
  case LAss thus ?case by(fastforce simp: LAssRedsVal)
next
  case LAssThrow thus ?case by(fastforce dest!:eval_final simp: LAssRedsThrow)
next
  case FAcc thus ?case by(fastforce intro:FAccRedsVal)
next
  case FAccNull thus ?case by(simp add:FAccRedsNull)
next
  case FAccThrow thus ?case by(fastforce dest!:eval_final simp:FAccRedsThrow)
next
  case FAss thus ?case by(fastforce simp:FAssRedsVal)
next
  case FAssNull thus ?case by(fastforce simp:FAssRedsNull)
next
  case FAssThrow1 thus ?case by(fastforce dest!:eval_final simp:FAssRedsThrow1)
next
  case FAssThrow2 thus ?case by(fastforce dest!:eval_final simp:FAssRedsThrow2)
next
  case CallObjThrow thus ?case by(fastforce dest!:eval_final simp:CallRedsThrowObj)
next
  case CallNull thus ?case thm CallRedsNull by(simp add:CallRedsNull)
next
  case CallParamsThrow thus ?case
    by(fastforce dest!:evals_final simp:CallRedsThrowParams)
next
  case (Call E e s⇩₀ a Cs s⇩₁ ps vs h⇩₂ l⇩₂ C S M Ts' T' pns' body' Ds Ts T pns
             body Cs' vs' l⇩₂' new_body e' h⇩₃ l⇩₃)
  have IHe: "P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨ref(a,Cs),s⇩₁⟩"
    and IHes: "P,E ⊢ ⟨ps,s⇩₁⟩ [→]* ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
    and h⇩₂a: "h⇩₂ a = Some(C,S)"
    and "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
    and select: "P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
    and same_length: "length vs = length pns"
    and casts: "P ⊢ Ts Casts vs to vs'"
    and l⇩₂': "l⇩₂' = [this ↦ Ref (a,Cs'), pns[↦]vs']"
    and body_case: "new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
    and eval_body: "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
                      ⟨new_body,(h⇩₂, l⇩₂')⟩ ⇒ ⟨e',(h⇩₃, l⇩₃)⟩"
    and IHbody: "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
                      ⟨new_body,(h⇩₂, l⇩₂')⟩ →* ⟨e',(h⇩₃, l⇩₃)⟩" by fact+
  from wwf select same_length have lengthTs:"length Ts = length vs"
    by (fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)
  show "P,E ⊢ ⟨e∙M(ps),s⇩₀⟩ →* ⟨e',(h⇩₃, l⇩₂)⟩"
    using "method" select same_length l⇩₂' h⇩₂a casts body_case
      IHbody eval_final[OF eval_body]
    by(fastforce intro!:CallRedsFinal[OF wwf IHe IHes])
next
  case (StaticCall E e s⇩₀ a Cs s⇩₁ ps vs h⇩₂ l⇩₂ C Cs'' M Ts T pns body Cs'
                   Ds vs' l⇩₂' e' h⇩₃ l⇩₃)
 have IHe: "P,E ⊢ ⟨e,s⇩₀⟩ →* ⟨ref(a,Cs),s⇩₁⟩"
   and IHes: "P,E ⊢ ⟨ps,s⇩₁⟩ [→]* ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
   and path_unique: "P ⊢ Path last Cs to C unique"
   and path_via: "P ⊢ Path last Cs to C via Cs''"
   and least: "P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
   and Ds: "Ds = (Cs @⇩_p Cs'') @⇩_p Cs'"
   and same_length: "length vs = length pns"
   and casts: "P ⊢ Ts Casts vs to vs'"
   and l⇩₂': "l⇩₂' = [this ↦ Ref (a,Ds), pns[↦]vs']"
   and eval_body: "P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ 
                         ⟨body,(h⇩₂, l⇩₂')⟩ ⇒ ⟨e',(h⇩₃, l⇩₃)⟩"
   and IHbody: "P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ 
                      ⟨body,(h⇩₂, l⇩₂')⟩ →* ⟨e',(h⇩₃, l⇩₃)⟩" by fact+
 from wwf least same_length have lengthTs:"length Ts = length vs"
    by (fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)
  show "P,E ⊢ ⟨e∙(C::)M(ps),s⇩₀⟩ →* ⟨e',(h⇩₃, l⇩₂)⟩"
    using path_unique path_via least Ds same_length l⇩₂' casts
      IHbody eval_final[OF eval_body]
    by(fastforce intro!:StaticCallRedsFinal[OF wwf IHe IHes])
next
  case Block with wwf show ?case by(fastforce simp: BlockRedsFinal dest:eval_final)
next
  case Seq thus ?case by(fastforce simp:SeqReds2)
next
  case SeqThrow thus ?case by(fastforce dest!:eval_final simp: SeqRedsThrow)
next
  case CondT thus ?case by(fastforce simp:CondReds2T)
next
  case CondF thus ?case by(fastforce simp:CondReds2F)
next
  case CondThrow thus ?case by(fastforce dest!:eval_final simp:CondRedsThrow)
next
  case WhileF thus ?case by(fastforce simp:WhileFReds)
next
  case WhileT thus ?case by(fastforce simp: WhileTReds)
next
  case WhileCondThrow thus ?case by(fastforce dest!:eval_final simp: WhileRedsThrow)
next
  case WhileBodyThrow thus ?case by(fastforce dest!:eval_final simp: WhileTRedsThrow)
next
  case Throw thus ?case by(fastforce simp:ThrowReds)
next
  case ThrowNull thus ?case by(fastforce simp:ThrowRedsNull)
next
  case ThrowThrow thus ?case by(fastforce dest!:eval_final simp:ThrowRedsThrow)
next
  case Nil thus ?case by simp
next
  case Cons thus ?case
    by(fastforce intro!:Cons_eq_appendI[OF refl refl] ListRedsVal)
next
  case ConsThrow thus ?case by(fastforce elim: ListReds1)
qed



subsection‹Big steps simulates small step›


text ‹The big step equivalent of ‹RedWhile›:› 

lemma unfold_while: 
  "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩  =  P,E ⊢ ⟨if(b) (c;;while(b) c) else (unit),s⟩ ⇒ ⟨e',s'⟩"

proof
  assume "P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
  thus "P,E ⊢ ⟨if (b) (c;; while (b) c) else unit,s⟩ ⇒ ⟨e',s'⟩"
    by cases (fastforce intro: eval_evals.intros)+
next
  assume "P,E ⊢ ⟨if (b) (c;; while (b) c) else unit,s⟩ ⇒ ⟨e',s'⟩"
  thus "P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨e',s'⟩"
  proof (cases)
    fix ex
    assume e': "e' = throw ex"
    assume "P,E ⊢ ⟨b,s⟩ ⇒ ⟨throw ex,s'⟩"  
    hence "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨throw ex,s'⟩" by (rule WhileCondThrow)
    with e' show ?thesis by simp
  next
    fix s⇩₁
    assume eval_false: "P,E ⊢ ⟨b,s⟩ ⇒ ⟨false,s⇩₁⟩"
    and eval_unit: "P,E ⊢ ⟨unit,s⇩₁⟩ ⇒ ⟨e',s'⟩"
    with eval_unit have "s' = s⇩₁" "e' = unit" by (auto elim: eval_cases)
    moreover from eval_false have "P,E ⊢ ⟨while (b) c,s⟩ ⇒ ⟨unit,s⇩₁⟩"
      by - (rule WhileF, simp)
    ultimately show ?thesis by simp
  next
    fix s⇩₁
    assume eval_true: "P,E ⊢ ⟨b,s⟩ ⇒ ⟨true,s⇩₁⟩"
    and eval_rest: "P,E ⊢ ⟨c;; while (b) c,s⇩₁⟩⇒⟨e',s'⟩"
    from eval_rest show ?thesis
    proof (cases)
      fix s⇩₂ v⇩₁
      assume "P,E ⊢ ⟨c,s⇩₁⟩ ⇒ ⟨Val v⇩₁,s⇩₂⟩" "P,E ⊢ ⟨while (b) c,s⇩₂⟩ ⇒ ⟨e',s'⟩"
      with eval_true show "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩" by (rule WhileT)
    next
      fix ex
      assume "P,E ⊢ ⟨c,s⇩₁⟩ ⇒ ⟨throw ex,s'⟩" "e' = throw ex"
      with eval_true show "P,E ⊢ ⟨while(b) c,s⟩ ⇒ ⟨e',s'⟩"
        by (iprover intro: WhileBodyThrow)
    qed
  qed
qed



lemma blocksEval:
  "⋀Ts vs l l' E. ⟦size ps = size Ts; size ps = size vs; 
                    P,E ⊢ ⟨blocks(ps,Ts,vs,e),(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟧
    ⟹ ∃ l'' vs'. P,E(ps [↦] Ts) ⊢ ⟨e,(h,l(ps[↦]vs'))⟩ ⇒ ⟨e',(h',l'')⟩ ∧
                   P ⊢ Ts Casts vs to vs' ∧ length vs' = length vs"

proof (induct ps)
  case Nil then show ?case by(fastforce intro:Casts_Nil)
next
  case (Cons p ps')
  have length_eqs: "length (p # ps') = length Ts" 
                   "length (p # ps') = length vs"
    and IH:"⋀Ts vs l l' E. ⟦length ps' = length Ts; length ps' = length vs;
                             P,E ⊢ ⟨blocks (ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨e',(h',l')⟩⟧
  ⟹ ∃l'' vs'. P,E(ps' [↦] Ts) ⊢ ⟨e,(h,l(ps' [↦] vs'))⟩ ⇒ ⟨e',(h', l'')⟩ ∧
                P ⊢ Ts Casts vs to vs' ∧ length vs' = length vs" by fact+
  then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
  obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
  with length_eqs Ts have length1:"length ps' = length Ts'" 
    and length2:"length ps' = length vs'" by simp_all
  have "P,E ⊢ ⟨blocks (p # ps', Ts, vs, e),(h,l)⟩ ⇒ ⟨e',(h', l')⟩" by fact
  with Ts vs
  have blocks:"P,E ⊢ ⟨{p:T := Val v; blocks (ps',Ts',vs',e)},(h,l)⟩ ⇒ ⟨e',(h',l')⟩"
    by simp
  then obtain l''' v' where
    eval_ps': "P,E(p ↦ T) ⊢ ⟨blocks (ps',Ts',vs',e),(h,l(p↦v'))⟩ ⇒ ⟨e',(h',l''')⟩"
    and l''': "l'=l'''(p:=l p)"
    and casts:"P ⊢ T casts v to v'"
    by(auto elim!: eval_cases simp:fun_upd_same)
  from IH[OF length1 length2 eval_ps'] obtain l'' vs'' where
    "P,E(p ↦ T)(ps' [↦] Ts') ⊢ ⟨e,(h, l(p↦v')(ps'[↦]vs''))⟩ ⇒ 
                                       ⟨e',(h',l'')⟩"
    and "P ⊢ Ts' Casts vs' to vs''"
    and "length vs'' = length vs'" by auto
  with Ts vs casts show ?case
    by -(rule_tac x="l''" in exI,rule_tac x="v'#vs''" in exI,simp,
         rule Casts_Cons)
qed



lemma CastblocksEval:
  "⋀Ts vs l l' E. ⟦size ps = size Ts; size ps = size vs; 
                   P,E ⊢ ⟨⦇C'⦈(blocks(ps,Ts,vs,e)),(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟧
    ⟹ ∃ l'' vs'. P,E(ps [↦] Ts) ⊢ ⟨⦇C'⦈e,(h,l(ps[↦]vs'))⟩ ⇒ ⟨e',(h',l'')⟩ ∧
                   P ⊢ Ts Casts vs to vs' ∧ length vs' = length vs"

proof (induct ps)
  case Nil then show ?case by(fastforce intro:Casts_Nil)
next
  case (Cons p ps')
  have length_eqs: "length (p # ps') = length Ts" 
                   "length (p # ps') = length vs" by fact+
  then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
  obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
  with length_eqs Ts have length1:"length ps' = length Ts'" 
    and length2:"length ps' = length vs'" by simp_all
  have "P,E ⊢ ⟨⦇C'⦈(blocks (p # ps', Ts, vs, e)),(h,l)⟩ ⇒ ⟨e',(h', l')⟩" by fact
  moreover
  { fix a Cs Cs'
    assume blocks:"P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨ref (a,Cs),(h',l')⟩"
      and path_via:"P ⊢ Path last Cs to C' via Cs'"
      and e':"e' = ref(a,Cs@⇩_pCs')"
    from blocks length_eqs obtain l'' vs''
      where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                 ⟨ref (a,Cs),(h',l'')⟩"
      and casts:"P ⊢ Ts Casts vs to vs''"
      and length:"length vs'' = length vs"
      by -(drule blocksEval,auto)
    from eval path_via have 
      "P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒ ⟨ref(a,Cs@⇩_pCs'),(h',l'')⟩"
      by(auto intro:StaticUpCast)
    with e' casts length have ?case by simp blast }
  moreover
  { fix a Cs Cs'
    assume blocks:"P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ 
                         ⟨ref (a,Cs@C'# Cs'),(h',l')⟩"
      and e':"e' = ref (a,Cs@[C'])"
    from blocks length_eqs obtain l'' vs''
      where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                 ⟨ref (a,Cs@C'# Cs'),(h',l'')⟩"
      and casts:"P ⊢ Ts Casts vs to vs''"
      and length:"length vs'' = length vs"
      by -(drule blocksEval,auto)
    from eval have "P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                             ⟨ref(a,Cs@[C']),(h',l'')⟩"
      by(auto intro:StaticDownCast)
    with e' casts length have ?case by simp blast }
  moreover
  { assume "P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨null,(h',l')⟩"
    and e':"e' = null"
    with length_eqs obtain l'' vs''
      where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                 ⟨null,(h',l'')⟩"
      and casts:"P ⊢ Ts Casts vs to vs''"
      and length:"length vs'' = length vs"
      by -(drule blocksEval,auto)
    from eval have "P,E(p#ps' [↦] Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                               ⟨null,(h',l'')⟩"
      by(auto intro:StaticCastNull)
    with e' casts length have ?case by simp blast }
  moreover
  { fix a Cs
    assume blocks:"P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨ref (a,Cs),(h',l')⟩"
      and notin:"C' ∉ set Cs" and leq:"¬ P ⊢ (last Cs) ≼⇧^* C'"
      and  e':"e' = THROW ClassCast"
    from blocks length_eqs obtain l'' vs''
      where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                 ⟨ref (a,Cs),(h',l'')⟩"
      and casts:"P ⊢ Ts Casts vs to vs''"
      and length:"length vs'' = length vs"
      by -(drule blocksEval,auto)
    from eval notin leq have 
      "P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                          ⟨THROW ClassCast,(h',l'')⟩"
      by(auto intro:StaticCastFail)
    with e' casts length have ?case by simp blast }
  moreover
  { fix r assume "P,E ⊢ ⟨blocks(p#ps',Ts,vs,e),(h,l)⟩ ⇒ ⟨throw r,(h',l')⟩"
    and e':"e' = throw r"
     with length_eqs obtain l'' vs''
      where eval:"P,E(p#ps' [↦] Ts) ⊢ ⟨e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                                 ⟨throw r,(h',l'')⟩"
      and casts:"P ⊢ Ts Casts vs to vs''"
      and length:"length vs'' = length vs"
      by -(drule blocksEval,auto)
    from eval have 
      "P,E(p#ps'[↦]Ts) ⊢ ⟨⦇C'⦈e,(h,l(p#ps'[↦]vs''))⟩ ⇒ 
                          ⟨throw r,(h',l'')⟩"
      by(auto intro:eval_evals.StaticCastThrow)
    with e' casts length have ?case by simp blast }
  ultimately show ?case
    by -(erule eval_cases,fastforce+)
qed



lemma
assumes wf: "wwf_prog P"
shows eval_restrict_lcl:
  "P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟹ (⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h,l|`W)⟩ ⇒ ⟨e',(h',l'|`W)⟩)"
and "P,E ⊢ ⟨es,(h,l)⟩ [⇒] ⟨es',(h',l')⟩ ⟹ (⋀W. fvs es ⊆ W ⟹ P,E ⊢ ⟨es,(h,l|`W)⟩ [⇒] ⟨es',(h',l'|`W)⟩)"

proof(induct rule:eval_evals_inducts)
  case (Block E V T e⇩₀ h⇩₀ l⇩₀ e⇩₁ h⇩₁ l⇩₁)
  have IH: "⋀W. fv e⇩₀ ⊆ W ⟹ 
                 P,E(V ↦ T) ⊢ ⟨e⇩₀,(h⇩₀,l⇩₀(V:=None)|`W)⟩ ⇒ ⟨e⇩₁,(h⇩₁,l⇩₁|`W)⟩" by fact
  (*have type:"is_type P T" .*)
  have "fv({V:T; e⇩₀}) ⊆ W" by fact
  hence "fv e⇩₀ - {V} ⊆ W" by simp_all
  hence "fv e⇩₀ ⊆ insert V W" by fast
  with IH[OF this]
  have "P,E(V ↦ T) ⊢ ⟨e⇩₀,(h⇩₀, (l⇩₀|`W)(V := None))⟩ ⇒ ⟨e⇩₁,(h⇩₁, l⇩₁|`insert V W)⟩"
    by fastforce
  from eval_evals.Block[OF this] show ?case by fastforce
next
  case Seq thus ?case by simp (blast intro:eval_evals.Seq)
next
  case New thus ?case by(simp add:eval_evals.intros)
next
  case NewFail thus ?case by(simp add:eval_evals.intros)
next
  case StaticUpCast thus ?case by simp (blast intro:eval_evals.StaticUpCast)
next
  case (StaticDownCast E e h l a Cs C Cs' h' l')
  have IH:"⋀W. fv e ⊆ W ⟹ 
                P,E ⊢ ⟨e,(h,l |` W)⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),(h',l' |` W)⟩" by fact
  have "fv (⦇C⦈e) ⊆ W" by fact
  hence "fv e ⊆ W" by simp
  from IH[OF this] show ?case by(rule eval_evals.StaticDownCast)
next
  case StaticCastNull thus ?case by simp (blast intro:eval_evals.StaticCastNull)
next
  case StaticCastFail thus ?case by simp (blast intro:eval_evals.StaticCastFail)
next
  case StaticCastThrow thus ?case by(simp add:eval_evals.intros)
next
  case DynCast thus ?case by simp (blast intro:eval_evals.DynCast)
next
  case StaticUpDynCast thus ?case by simp (blast intro:eval_evals.StaticUpDynCast)
next
  case (StaticDownDynCast E e h l a Cs C Cs' h' l')
  have IH:"⋀W. fv e ⊆ W ⟹ 
                P,E ⊢ ⟨e,(h,l |` W)⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),(h',l' |` W)⟩" by fact
  have "fv (Cast C e) ⊆ W" by fact
  hence "fv e ⊆ W" by simp
  from IH[OF this] show ?case by(rule eval_evals.StaticDownDynCast)
next
  case DynCastNull thus ?case by simp (blast intro:eval_evals.DynCastNull)
next
  case DynCastFail thus ?case by simp (blast intro:eval_evals.DynCastFail)
next
  case DynCastThrow thus ?case by(simp add:eval_evals.intros)
next
  case Val thus ?case by(simp add:eval_evals.intros)
next
  case BinOp thus ?case by simp (blast intro:eval_evals.BinOp)
next
  case BinOpThrow1 thus ?case by simp (blast intro:eval_evals.BinOpThrow1)
next
  case BinOpThrow2 thus ?case by simp (blast intro:eval_evals.BinOpThrow2)
next
  case Var thus ?case by(simp add:eval_evals.intros)
next
  case (LAss E e h⇩₀ l⇩₀ v h l V T v' l')
  have IH: "⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h⇩₀,l⇩₀|`W)⟩ ⇒ ⟨Val v,(h,l|`W)⟩"
    and env:"E V = ⌊T⌋" and casts:"P ⊢ T casts v to v'"
    and [simp]: "l' = l(V ↦ v')" by fact+
  have "fv (V:=e) ⊆ W" by fact
  hence fv: "fv e ⊆ W" and VinW: "V ∈ W" by auto
  from eval_evals.LAss[OF IH[OF fv] _ casts] env VinW
  show ?case by fastforce
next
  case LAssThrow thus ?case by(fastforce intro: eval_evals.LAssThrow)
next
  case FAcc thus ?case by simp (blast intro: eval_evals.FAcc)
next
  case FAccNull thus ?case by(fastforce intro: eval_evals.FAccNull)
next
  case FAccThrow thus ?case by(fastforce intro: eval_evals.FAccThrow)
next
  case (FAss E e⇩₁ h l a Cs' h' l' e⇩₂ v h⇩₂ l⇩₂ D S F T Cs v' Ds fs fs' S' h⇩₂' W)
  have IH1: "⋀W. fv e⇩₁ ⊆ W ⟹ P,E ⊢ ⟨e⇩₁,(h, l|`W)⟩ ⇒ ⟨ref (a, Cs'),(h', l'|`W)⟩"
    and IH2: "⋀W. fv e⇩₂ ⊆ W ⟹ P,E ⊢ ⟨e⇩₂,(h', l'|`W)⟩ ⇒ ⟨Val v,(h⇩₂, l⇩₂|`W)⟩"
    and fv:"fv (e⇩₁∙F{Cs} := e⇩₂) ⊆ W"
    and h:"h⇩₂ a = Some(D,S)" and Ds:"Ds = Cs' @⇩_p Cs"
    and S:"(Ds,fs) ∈ S" and fs':"fs' = fs(F ↦ v')"
    and S':"S' = S - {(Ds, fs)} ∪ {(Ds, fs')}" 
    and h':"h⇩₂' = h⇩₂(a ↦ (D, S'))" 
    and field:"P ⊢ last Cs' has least F:T via Cs"
    and casts:"P ⊢ T casts v to v'" by fact+
  from fv have fv1:"fv e⇩₁ ⊆ W" and fv2:"fv e⇩₂ ⊆ W" by auto
  from eval_evals.FAss[OF IH1[OF fv1] IH2[OF fv2] _ field casts] h Ds S fs' S' h'
  show ?case by simp
next
  case FAssNull thus ?case by simp (blast intro: eval_evals.FAssNull)
next
  case FAssThrow1 thus ?case by simp (blast intro: eval_evals.FAssThrow1)
next
  case FAssThrow2 thus ?case by simp (blast intro: eval_evals.FAssThrow2)
next
  case CallObjThrow thus ?case by simp (blast intro: eval_evals.intros)
next
  case CallNull thus ?case by simp (blast intro: eval_evals.CallNull)
next
  case CallParamsThrow thus ?case
    by simp (blast intro: eval_evals.CallParamsThrow)
next
  case (Call E e h⇩₀ l⇩₀ a Cs h⇩₁ l⇩₁ ps vs h⇩₂ l⇩₂ C S M Ts' T' pns'
             body' Ds Ts T pns body Cs' vs' l⇩₂' new_body e' h⇩₃ l⇩₃ W)
  have IHe: "⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h⇩₀,l⇩₀|`W)⟩ ⇒ ⟨ref(a,Cs),(h⇩₁,l⇩₁|`W)⟩"
    and IHps: "⋀W. fvs ps ⊆ W ⟹ P,E ⊢ ⟨ps,(h⇩₁,l⇩₁|`W)⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂|`W)⟩"
    and IHbd: "⋀W. fv new_body ⊆ W ⟹ P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
                                    ⟨new_body,(h⇩₂,l⇩₂'|`W)⟩ ⇒ ⟨e',(h⇩₃,l⇩₃|`W)⟩"
    and h⇩₂a: "h⇩₂ a = Some (C,S)"
    and "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
    and select:"P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
    and same_len: "size vs = size pns"
    and casts:"P ⊢ Ts Casts vs to vs'"
    and l⇩₂': "l⇩₂' = [this ↦ Ref(a,Cs'), pns [↦] vs']"
    and body_case: "new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)" by fact+
  have "fv (e∙M(ps)) ⊆ W" by fact
  hence fve: "fv e ⊆ W" and fvps: "fvs(ps) ⊆ W" by auto
  have wfmethod: "size Ts = size pns ∧ this ∉ set pns" and
       fvbd: "fv body ⊆ {this} ∪ set pns"
    using select wf by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
  from fvbd body_case have fvbd':"fv new_body ⊆ {this} ∪ set pns"
    by(cases T') auto
  from l⇩₂' have "l⇩₂' |` ({this} ∪ set pns) = [this ↦ Ref (a, Cs'), pns [↦] vs']"
    by (auto intro!:ext simp:restrict_map_def fun_upd_def)
  with eval_evals.Call[OF IHe[OF fve] IHps[OF fvps] _ "method" select same_len
                          casts _ body_case IHbd[OF fvbd']] h⇩₂a
  show ?case by simp
next
  case (StaticCall E e h⇩₀ l⇩₀ a Cs h⇩₁ l⇩₁ ps vs h⇩₂ l⇩₂ C Cs'' M Ts T pns body
                   Cs' Ds vs' l⇩₂' e' h⇩₃ l⇩₃ W)
  have IHe: "⋀W. fv e ⊆ W ⟹ P,E ⊢ ⟨e,(h⇩₀,l⇩₀|`W)⟩ ⇒ ⟨ref(a,Cs),(h⇩₁,l⇩₁|`W)⟩"
    and IHps: "⋀W. fvs ps ⊆ W ⟹ P,E ⊢ ⟨ps,(h⇩₁,l⇩₁|`W)⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂|`W)⟩"
    and IHbd: "⋀W. fv body ⊆ W ⟹ P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ 
                                    ⟨body,(h⇩₂,l⇩₂'|`W)⟩ ⇒ ⟨e',(h⇩₃,l⇩₃|`W)⟩"
    and path_unique: "P ⊢ Path last Cs to C unique"
    and path_via: "P ⊢ Path last Cs to C via Cs''"
    and least: "P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
    and Ds: "Ds = (Cs @⇩_p Cs'') @⇩_p Cs'"
    and same_len: "size vs = size pns"
    and casts:"P ⊢ Ts Casts vs to vs'"
    and l⇩₂': "l⇩₂' = [this ↦ Ref(a,Ds), pns [↦] vs']" by fact+
  have "fv (e∙(C::)M(ps)) ⊆ W" by fact
  hence fve: "fv e ⊆ W" and fvps: "fvs(ps) ⊆ W" by auto
  have wfmethod: "size Ts = size pns ∧ this ∉ set pns" and
       fvbd: "fv body ⊆ {this} ∪ set pns"
    using least wf by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
  from fvbd have fvbd':"fv body ⊆ {this} ∪ set pns"
    by auto
  from l⇩₂' have "l⇩₂' |` ({this} ∪ set pns) = [this ↦ Ref(a,Ds), pns [↦] vs']"
    by (auto intro!:ext simp:restrict_map_def fun_upd_def)
  with eval_evals.StaticCall[OF IHe[OF fve] IHps[OF fvps] path_unique path_via
                                least Ds same_len casts _ IHbd[OF fvbd']]
  show ?case by simp
next
  case SeqThrow thus ?case by simp (blast intro: eval_evals.SeqThrow)
next
  case CondT thus ?case by simp (blast intro: eval_evals.CondT)
next
  case CondF thus ?case by simp (blast intro: eval_evals.CondF)
next
  case CondThrow thus ?case by simp (blast intro: eval_evals.CondThrow)
next
  case WhileF thus ?case by simp (blast intro: eval_evals.WhileF)
next
  case WhileT thus ?case by simp (blast intro: eval_evals.WhileT)
next
  case WhileCondThrow thus ?case by simp (blast intro: eval_evals.WhileCondThrow)
next
  case WhileBodyThrow thus ?case by simp (blast intro: eval_evals.WhileBodyThrow)
next
  case Throw thus ?case by simp (blast intro: eval_evals.Throw)
next
  case ThrowNull thus ?case by simp (blast intro: eval_evals.ThrowNull)
next
  case ThrowThrow thus ?case by simp (blast intro: eval_evals.ThrowThrow)
next
  case Nil thus ?case by (simp add: eval_evals.Nil)
next
  case Cons thus ?case by simp (blast intro: eval_evals.Cons)
next
  case ConsThrow thus ?case by simp (blast intro: eval_evals.ConsThrow)
qed



lemma eval_notfree_unchanged:
assumes wf:"wwf_prog P"
shows "P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩ ⟹ (⋀V. V ∉ fv e ⟹ l' V = l V)"
and "P,E ⊢ ⟨es,(h,l)⟩ [⇒] ⟨es',(h',l')⟩ ⟹ (⋀V. V ∉ fvs es ⟹ l' V = l V)"

proof(induct rule:eval_evals_inducts)
  case LAss thus ?case by(simp add:fun_upd_apply)
next
  case Block thus ?case
    by (simp only:fun_upd_apply split:if_splits) fastforce
qed simp_all



lemma eval_closed_lcl_unchanged:
  assumes wf:"wwf_prog P"
  and eval:"P,E ⊢ ⟨e,(h,l)⟩ ⇒ ⟨e',(h',l')⟩"
  and fv:"fv e = {}"
  shows "l' = l"

proof -
  from wf eval have "⋀V. V ∉ fv e ⟹ l' V = l V" by (rule eval_notfree_unchanged)
  with fv have "⋀V. l' V = l V" by simp
  thus ?thesis by(simp add:fun_eq_iff)
qed



(* Hiermit kann man die ganze pair-Splitterei in den automatischen Taktiken
abschalten. Wieder anschalten siehe nach dem Beweis. *)

declare split_paired_All [simp del] split_paired_Ex [simp del]

declaration ‹K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac"))›
setup ‹map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac")›


lemma list_eval_Throw: 
assumes eval_e: "P,E ⊢ ⟨throw x,s⟩ ⇒ ⟨e',s'⟩"
shows "P,E ⊢ ⟨map Val vs @ throw x # es',s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"

proof -
  from eval_e 
  obtain a where e': "e' = Throw a"
    by (cases) (auto dest!: eval_final)
  {
    fix es
    have "⋀vs. es = map Val vs @ throw x # es' 
           ⟹ P,E ⊢ ⟨es,s⟩[⇒]⟨map Val vs @ e' # es',s'⟩"
    proof (induct es type: list)
      case Nil thus ?case by simp
    next
      case (Cons e es vs)
      have e_es: "e # es = map Val vs @ throw x # es'" by fact
      show "P,E ⊢ ⟨e # es,s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
      proof (cases vs)
        case Nil
        with e_es obtain "e=throw x" "es=es'" by simp
        moreover from eval_e e'
        have "P,E ⊢ ⟨throw x # es,s⟩ [⇒] ⟨Throw a # es,s'⟩"
          by (iprover intro: ConsThrow)
        ultimately show ?thesis using Nil e' by simp
      next
        case (Cons v vs')
        have vs: "vs = v # vs'" by fact
        with e_es obtain 
          e: "e=Val v" and es:"es= map Val vs' @ throw x # es'"
          by simp
        from e 
        have "P,E ⊢ ⟨e,s⟩ ⇒ ⟨Val v,s⟩"
          by (iprover intro: eval_evals.Val)
        moreover from es 
        have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs' @ e' # es',s'⟩"
          by (rule Cons.hyps)
        ultimately show 
          "P,E ⊢ ⟨e#es,s⟩ [⇒] ⟨map Val vs @ e' # es',s'⟩"
          using vs by (auto intro: eval_evals.Cons)
      qed
    qed
  }
  thus ?thesis
    by simp
qed




text ‹The key lemma:›

lemma
assumes wf: "wwf_prog P"
shows extend_1_eval:
  "P,E ⊢ ⟨e,s⟩ → ⟨e'',s''⟩ ⟹  (⋀s' e'. P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩ ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩)"
and extend_1_evals:
  "P,E ⊢ ⟨es,t⟩ [→] ⟨es'',t''⟩ ⟹ (⋀t' es'. P,E ⊢ ⟨es'',t''⟩ [⇒] ⟨es',t'⟩ ⟹ P,E ⊢ ⟨es,t⟩ [⇒] ⟨es',t'⟩)"

proof (induct rule: red_reds.inducts)
 case RedNew thus ?case by (iprover elim: eval_cases intro: eval_evals.intros)
next
  case RedNewFail thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (StaticCastRed E e s e'' s'' C s' e') thus ?case
    by -(erule eval_cases,auto intro:eval_evals.intros,
         subgoal_tac "P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),s'⟩",
         rule_tac Cs'="Cs'" in StaticDownCast,auto)
next
  case RedStaticCastNull thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedStaticUpCast thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedStaticDownCast thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedStaticCastFail thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedStaticUpDynCast thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedStaticDownDynCast thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (DynCastRed E e s e'' s'' C s' e')
  have eval:"P,E ⊢ ⟨Cast C e'',s''⟩ ⇒ ⟨e',s'⟩"
    and IH:"⋀ex sx. P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨ex,sx⟩ ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨ex,sx⟩" by fact+
  moreover 
  { fix Cs Cs' a
    assume "P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨ref (a, Cs @ C # Cs'),s'⟩"
    from IH[OF this] have "P,E ⊢ ⟨e,s⟩ ⇒ ⟨ref (a, Cs@[C]@Cs'),s'⟩" by simp
    hence "P,E ⊢ ⟨Cast C e,s⟩ ⇒ ⟨ref (a, Cs@[C]),s'⟩" by(rule StaticDownDynCast) }
  ultimately show ?case by -(erule eval_cases,auto intro: eval_evals.intros)
next
  case RedDynCastNull thus ?case by (iprover elim:eval_cases intro:eval_evals.intros)
next
  case (RedDynCast s a D S C Cs' E Cs s' e')
  thus ?case by (cases s)(auto elim!:eval_cases intro:eval_evals.intros)
next
  case (RedDynCastFail s a D S C Cs E s'' e'')
  thus ?case by (cases s)(auto elim!: eval_cases intro: eval_evals.intros)
next
  case BinOpRed1 thus ?case by -(erule eval_cases,auto intro: eval_evals.intros)
next
  case BinOpRed2 
  thus ?case by (fastforce elim!:eval_cases intro:eval_evals.intros eval_finalId)
next
  case RedBinOp thus ?case by (iprover elim:eval_cases intro:eval_evals.intros)
next
  case (RedVar s V v E s' e')
  thus ?case by (cases s)(fastforce elim:eval_cases intro:eval_evals.intros)
next
  case LAssRed thus ?case by -(erule eval_cases,auto intro:eval_evals.intros)
next
  case RedLAss
  thus ?case by (fastforce elim:eval_cases intro:eval_evals.intros)
next
  case FAccRed thus ?case by -(erule eval_cases,auto intro:eval_evals.intros)
next
  case (RedFAcc s a D S Ds Cs' Cs fs F v E s' e')
  thus ?case by (cases s)(fastforce elim:eval_cases intro:eval_evals.intros)
next
  case RedFAccNull thus ?case by (fastforce elim!:eval_cases intro:eval_evals.intros)
next
  case (FAssRed1 E e⇩₁ s e⇩₁' s'' F Cs e⇩₂ s' e')
  have eval:"P,E ⊢ ⟨e⇩₁'∙F{Cs} := e⇩₂,s''⟩ ⇒ ⟨e',s'⟩"
    and IH:"⋀ex sx. P,E ⊢ ⟨e⇩₁',s''⟩ ⇒ ⟨ex,sx⟩ ⟹ P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨ex,sx⟩" by fact+
  { fix Cs' D S T a fs h⇩₂ l⇩₂ s⇩₁ v v'
    assume ref:"P,E ⊢ ⟨e⇩₁',s''⟩ ⇒ ⟨ref (a, Cs'),s⇩₁⟩" 
      and rest:"P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨Val v,(h⇩₂, l⇩₂)⟩" "h⇩₂ a = ⌊(D, S)⌋" 
      "P ⊢ last Cs' has least F:T via Cs" "P ⊢ T casts v to v'"
      "(Cs' @⇩_p Cs, fs) ∈ S"
    from IH[OF ref] have "P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨ref (a, Cs'),s⇩₁⟩" .
    with rest have "P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⟩ ⇒
          ⟨Val v',(h⇩₂(a ↦ (D,insert (Cs'@⇩_pCs,fs(F ↦ v'))(S - {(Cs'@⇩_pCs,fs)}))),l⇩₂)⟩"
      by-(rule FAss,simp_all) }
  moreover
  { fix s⇩₁ v 
    assume null:"P,E ⊢ ⟨e⇩₁',s''⟩ ⇒ ⟨null,s⇩₁⟩" 
      and rest:"P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨Val v,s'⟩"
    from IH[OF null] have "P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨null,s⇩₁⟩" .
    with rest have "P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⟩ ⇒ ⟨THROW NullPointer,s'⟩"
      by-(rule FAssNull,simp_all) }
  moreover
  { fix e' assume throw:"P,E ⊢ ⟨e⇩₁',s''⟩ ⇒ ⟨throw e',s'⟩"
    from IH[OF throw] have "P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨throw e',s'⟩" .
    hence "P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⟩ ⇒ ⟨throw e',s'⟩"
      by-(rule eval_evals.FAssThrow1,simp_all) }
  moreover
  { fix e' s⇩₁ v
    assume val:"P,E ⊢ ⟨e⇩₁',s''⟩ ⇒ ⟨Val v,s⇩₁⟩"
      and rest:"P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨throw e',s'⟩"
    from IH[OF val] have "P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨Val v,s⇩₁⟩" .
    with rest have "P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⟩ ⇒ ⟨throw e',s'⟩"
      by-(rule eval_evals.FAssThrow2,simp_all) }
  ultimately show ?case using eval
    by -(erule eval_cases,auto)
next
  case (FAssRed2 E e⇩₂ s e⇩₂' s'' v F Cs s' e')
  have eval:"P,E ⊢ ⟨Val v∙F{Cs} := e⇩₂',s''⟩ ⇒ ⟨e',s'⟩"
    and IH:"⋀ex sx. P,E ⊢ ⟨e⇩₂',s''⟩ ⇒ ⟨ex,sx⟩ ⟹ P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨ex,sx⟩" by fact+
  { fix Cs' D S T a fs h⇩₂ l⇩₂ s⇩₁ v' v''
    assume val1:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨ref (a,Cs'),s⇩₁⟩"
      and val2:"P,E ⊢ ⟨e⇩₂',s⇩₁⟩ ⇒ ⟨Val v',(h⇩₂, l⇩₂)⟩"
      and rest:"h⇩₂ a = ⌊(D, S)⌋" "P ⊢ last Cs' has least F:T via Cs"
               "P ⊢ T casts v' to v''" "(Cs'@⇩_pCs,fs) ∈ S"
    from val1 have s'':"s⇩₁ = s''" by -(erule eval_cases)
    with val1 have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨ref (a,Cs'),s⟩"
      by(fastforce elim:eval_cases intro:eval_finalId)
    also from IH[OF val2[simplified s'']] have "P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val v',(h⇩₂, l⇩₂)⟩" .
    ultimately have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩₂,s⟩ ⇒
           ⟨Val v'',(h⇩₂(a↦(D,insert(Cs'@⇩_pCs,fs(F ↦ v''))(S - {(Cs'@⇩_pCs,fs)}))),l⇩₂)⟩"
      using rest by -(rule FAss,simp_all) }
  moreover
  { fix s⇩₁ v'
    assume val1:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨null,s⇩₁⟩"
      and val2:"P,E ⊢ ⟨e⇩₂',s⇩₁⟩ ⇒ ⟨Val v',s'⟩"
    from val1 have s'':"s⇩₁ = s''" by -(erule eval_cases)
    with val1 have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨null,s⟩"
      by(fastforce elim:eval_cases intro:eval_finalId)
    also from IH[OF val2[simplified s'']] have "P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val v',s'⟩" .
    ultimately have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩₂,s⟩ ⇒ ⟨THROW NullPointer,s'⟩"
      by -(rule FAssNull,simp_all) }
  moreover
  { fix r assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨throw r,s'⟩"
    hence s'':"s'' = s'" by -(erule eval_cases,simp)
    with val have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩₂,s⟩ ⇒ ⟨throw r,s'⟩" 
      by -(rule eval_evals.FAssThrow1,erule eval_cases,simp) }
  moreover
  { fix r s⇩₁ v'
    assume val1:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨Val v',s⇩₁⟩"
      and val2:"P,E ⊢ ⟨e⇩₂',s⇩₁⟩ ⇒ ⟨throw r,s'⟩"
    from val1 have s'':"s⇩₁ = s''" by -(erule eval_cases)
    with val1 have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v',s⟩"
      by(fastforce elim:eval_cases intro:eval_finalId)
    also from IH[OF val2[simplified s'']] have "P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨throw r,s'⟩" .
    ultimately have "P,E ⊢ ⟨Val v∙F{Cs} := e⇩₂,s⟩ ⇒ ⟨throw r,s'⟩" 
      by -(rule eval_evals.FAssThrow2,simp_all) }
  ultimately show ?case using eval
    by -(erule eval_cases,auto)
next
  case (RedFAss h a D S Cs' F T Cs v v' Ds fs E l s' e')
  have val:"P,E ⊢ ⟨Val v',(h(a ↦ (D,insert (Ds,fs(F ↦ v'))(S - {(Ds,fs)}))),l)⟩ ⇒ 
                  ⟨e',s'⟩"
    and rest:"h a = ⌊(D, S)⌋" "P ⊢ last Cs' has least F:T via Cs"
             "P ⊢ T casts v to v'" "Ds = Cs' @⇩_p Cs" "(Ds, fs) ∈ S" by fact+
  from val have "s' = (h(a ↦ (D,insert (Ds,fs(F ↦ v')) (S - {(Ds,fs)}))),l)"
    and "e' = Val v'" by -(erule eval_cases,simp_all)+
  with rest show ?case apply simp
    by(rule FAss,simp_all)(rule eval_finalId,simp)+
next
  case RedFAssNull
  thus ?case by (fastforce elim!: eval_cases intro: eval_evals.intros)
next
  case (CallObj E e s e' s' Copt M es s'' e'')
  thus ?case
    apply -
    apply(cases Copt,simp)
    by(erule eval_cases,auto intro:eval_evals.intros)+
next
  case (CallParams E es s es' s'' v Copt M s' e')
  have call:"P,E ⊢ ⟨Call (Val v) Copt M es',s''⟩ ⇒ ⟨e',s'⟩"
    and IH:"⋀esx sx. P,E ⊢ ⟨es',s''⟩ [⇒] ⟨esx,sx⟩ ⟹ P,E ⊢ ⟨es,s⟩ [⇒] ⟨esx,sx⟩" by fact+
  show ?case
    proof(cases Copt)
    case None with call have eval:"P,E ⊢ ⟨Val v∙M(es'),s''⟩ ⇒ ⟨e',s'⟩" by simp
    from eval show ?thesis
    proof(rule eval_cases)
      fix r assume "P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨throw r,s'⟩" "e' = throw r"
      with None show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
        by(fastforce elim:eval_cases)
    next
      fix es'' r sx v' vs
      assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨Val v',sx⟩"
        and evals:"P,E ⊢ ⟨es',sx⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
        and e':"e' = throw r"
      have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by(rule Val)
      from val have eq:"v' = v ∧ s'' = sx" by -(erule eval_cases,simp)
      with IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
        by simp
      with eq CallParamsThrow[OF val'] e' None
      show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
        by fastforce
    next
      fix C Cs Cs' Ds S T T' Ts Ts' a body body' h⇩₂ h⇩₃ l⇩₂ l⇩₃ pns pns' s⇩₁ vs vs'
      assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨ref(a,Cs),s⇩₁⟩"
        and evals:"P,E ⊢ ⟨es',s⇩₁⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
        and hp:"h⇩₂ a = Some(C, S)"
        and "method":"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
        and select:"P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
        and length:"length vs = length pns"
        and casts:"P ⊢ Ts Casts vs to vs'"
        and body:"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
    ⟨case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body,(h⇩₂,[this ↦ Ref(a,Cs'),pns [↦] vs'])⟩
        ⇒ ⟨e',(h⇩₃, l⇩₃)⟩"
        and s':"s' = (h⇩₃, l⇩₂)"
      from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨ref(a,Cs),s⟩"
        and eq:"s'' = s⇩₁ ∧ v = Ref(a,Cs)"
        by(auto elim:eval_cases intro:Val)
      from body obtain new_body 
        where body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
        and body':"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
        ⟨new_body,(h⇩₂,[this ↦ Ref(a,Cs'),pns [↦] vs'])⟩ ⇒ ⟨e',(h⇩₃, l⇩₃)⟩"
        by simp
      from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩" by simp
      with eq Call[OF val' _ _ "method" select length casts _ body_case] 
           hp body' s' None
      show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩" by fastforce
    next
      fix s⇩₁ vs
      assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨null,s⇩₁⟩"
        and evals:"P,E ⊢ ⟨es',s⇩₁⟩ [⇒] ⟨map Val vs,s'⟩"
        and e':"e' = THROW NullPointer"
      from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨null,s⟩"
        and eq:"s'' = s⇩₁ ∧ v = Null"
        by(auto elim:eval_cases intro:Val)
      from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,s'⟩" by simp
      with eq CallNull[OF val'] e' None
      show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩" by fastforce
    qed
  next
    case (Some C) with call have eval:"P,E ⊢ ⟨Val v∙(C::)M(es'),s''⟩ ⇒ ⟨e',s'⟩"
      by simp
    from eval show ?thesis
    proof(rule eval_cases)
      fix r assume "P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨throw r,s'⟩" "e' = throw r"
      with Some show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
        by(fastforce elim:eval_cases)
    next
      fix es'' r sx v' vs
      assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨Val v',sx⟩"
        and evals:"P,E ⊢ ⟨es',sx⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
        and e':"e' = throw r"
      have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by(rule Val)
      from val have eq:"v' = v ∧ s'' = sx" by -(erule eval_cases,simp)
      with IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ throw r # es'',s'⟩"
        by simp
      with eq CallParamsThrow[OF val'] e' Some
      show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
        by fastforce
    next
      fix Cs Cs' Cs'' T Ts a body h⇩₂ h⇩₃ l⇩₂ l⇩₃ pns s⇩₁ vs vs'
      assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨ref (a,Cs),s⇩₁⟩"
        and evals:"P,E ⊢ ⟨es',s⇩₁⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
        and path_unique:"P ⊢ Path last Cs to C unique"
        and path_via:"P ⊢ Path last Cs to C via Cs''"
        and least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
        and length:"length vs = length pns"
        and casts:"P ⊢ Ts Casts vs to vs'"
        and body:"P,E(this ↦ Class (last ((Cs @⇩_p Cs'') @⇩_p Cs')), pns [↦] Ts) ⊢ 
           ⟨body,(h⇩₂,[this ↦ Ref(a,(Cs@⇩_pCs'')@⇩_pCs'),pns [↦] vs'])⟩ ⇒ ⟨e',(h⇩₃,l⇩₃)⟩"
        and s':"s' = (h⇩₃,l⇩₂)"
      from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨ref(a,Cs),s⟩"
        and eq:"s'' = s⇩₁ ∧ v = Ref(a,Cs)"
        by(auto elim:eval_cases intro:Val)
      from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩" by simp
      with eq StaticCall[OF val' _ path_unique path_via least _ _ casts _ body] 
           length s' Some
      show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩" by fastforce
    next
      fix s⇩₁ vs
      assume val:"P,E ⊢ ⟨Val v,s''⟩ ⇒ ⟨null,s⇩₁⟩"
        and evals:"P,E ⊢ ⟨es',s⇩₁⟩ [⇒] ⟨map Val vs,s'⟩"
        and e':"e' = THROW NullPointer"
      from val have val':"P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨null,s⟩"
        and eq:"s'' = s⇩₁ ∧ v = Null"
        by(auto elim:eval_cases intro:Val)
      from eq IH evals have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,s'⟩" by simp
      with eq CallNull[OF val'] e' Some
      show "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨e',s'⟩"
        by fastforce
    qed
  qed
next
  case (RedCall s a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs' vs
                bs new_body E s' e')
  obtain h l where "s' = (h,l)" by(cases s') auto
  have "P,E ⊢ ⟨ref(a,Cs),s⟩ ⇒ ⟨ref(a,Cs),s⟩" by (rule eval_evals.intros)
  moreover
  have finals: "finals(map Val vs)" by simp
  obtain h⇩₂ l⇩₂ where s: "s = (h⇩₂,l⇩₂)" by (cases s)
  with finals have "P,E ⊢ ⟨map Val vs,s⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
    by (iprover intro: eval_finalsId)
  moreover from s have h⇩₂a:"h⇩₂ a = Some (C,S)" using RedCall by simp
  moreover have "method": "P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds" by fact
  moreover have select:"P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'" by fact
  moreover have blocks:"bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)" by fact
  moreover have body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈bs | _ ⇒ bs)" by fact
  moreover have same_len⇩₁: "length Ts = length pns"
   and this_distinct: "this ∉ set pns" and fv: "fv body ⊆ {this} ∪ set pns"
    using select wf by (fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
  have same_len: "length vs = length pns" by fact
  moreover
  obtain h⇩₃ l⇩₃ where s': "s' = (h⇩₃,l⇩₃)" by (cases s')
  have eval_blocks:"P,E ⊢ ⟨new_body,s⟩ ⇒ ⟨e',s'⟩" by fact
  hence id: "l⇩₃ = l⇩₂" using fv s s' same_len⇩₁ same_len wf blocks body_case
    by(cases T')(auto elim!: eval_closed_lcl_unchanged)
  from same_len⇩₁ have same_len':"length(this#pns) = length(Class (last Cs')#Ts)" 
    by simp
  from same_len⇩₁ same_len
  have same_len⇩₂:"length(this#pns) = length(Ref(a,Cs')#vs)" by simp
  from eval_blocks
  have eval_blocks':"P,E ⊢ ⟨new_body,(h⇩₂,l⇩₂)⟩ ⇒ ⟨e',(h⇩₃,l⇩₃)⟩" using s s' by simp
  have casts_unique:"⋀vs'. P ⊢ Class (last Cs')#Ts Casts Ref(a,Cs')#vs to vs'
                            ⟹ vs' = Ref(a,Cs')#tl vs'"
    using wf
    by -(erule Casts_to.cases,auto elim!:casts_to.cases dest!:mdc_eq_last
                                      simp:path_via_def appendPath_def)
  have "∃l'' vs' new_body'. P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ 
              ⟨new_body',(h⇩₂,l⇩₂(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ ⟨e',(h⇩₃, l'')⟩ ∧ 
     P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs' ∧
     length vs' = length vs ∧ fv new_body' ⊆ {this} ∪ set pns ∧
     new_body' = (case T' of Class D ⇒ ⦇D⦈body  | _  ⇒ body)"
  proof(cases "∀C. T' ≠ Class C")
    case True
    with same_len' same_len⇩₂ eval_blocks' casts_unique body_case blocks
    obtain l'' vs'
      where body:"P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ 
                    ⟨body,(h⇩₂,l⇩₂(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ ⟨e',(h⇩₃, l'')⟩"
      and casts:"P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
      and lengthvs':"length vs' = length vs"
      by -(drule_tac vs="Ref(a,Cs')#vs" in blocksEval,assumption,cases T',
           auto simp:length_Suc_conv,blast)
    with fv True show ?thesis by(cases T') auto
  next
    case False
    then obtain D where T':"T' = Class D" by auto
    with same_len' same_len⇩₂ eval_blocks' casts_unique body_case blocks
    obtain l'' vs'
      where body:"P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ 
                    ⟨⦇D⦈body,(h⇩₂,l⇩₂(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ 
                    ⟨e',(h⇩₃, l'')⟩"
      and casts:"P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
      and lengthvs':"length vs' = length vs"
      by - (drule_tac vs="Ref(a,Cs')#vs" in CastblocksEval,
            assumption,simp,clarsimp simp:length_Suc_conv,auto)
    from fv have "fv (⦇D⦈body) ⊆ {this} ∪ set pns"
      by simp
    with body casts lengthvs' T' show ?thesis by auto
  qed
  then obtain l'' vs' new_body'
    where body:"P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ 
               ⟨new_body',(h⇩₂,l⇩₂(this # pns[↦]Ref(a,Cs')#vs'))⟩ ⇒ ⟨e',(h⇩₃, l'')⟩"
    and casts:"P ⊢ Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
    and lengthvs':"length vs' = length vs"
    and body_case':"new_body' = (case T' of Class D ⇒ ⦇D⦈body  | _ ⇒ body)"
    and fv':"fv new_body' ⊆ {this} ∪ set pns"
    by auto
  from same_len⇩₂ lengthvs'
  have same_len⇩₃:"length (this # pns) = length (Ref (a, Cs') # vs')" by simp
  from restrict_map_upds[OF same_len⇩₃,of "set(this#pns)" "l⇩₂"]
  have "l⇩₂(this # pns[↦]Ref(a,Cs')#vs')|`(set(this#pns)) = 
          [this # pns[↦]Ref(a,Cs')#vs']" by simp
  with eval_restrict_lcl[OF wf body fv'] this_distinct same_len⇩₁ same_len
  have "P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ 
   ⟨new_body',(h⇩₂,[this # pns[↦]Ref(a,Cs')#vs'])⟩ ⇒ ⟨e',(h⇩₃, l''|`(set(this#pns)))⟩"
    by simp
  with casts obtain l⇩₂' l⇩₃' vs' where
        "P ⊢ Ts Casts vs to vs'"
    and "P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ 
                                      ⟨new_body',(h⇩₂,l⇩₂')⟩ ⇒ ⟨e',(h⇩₃,l⇩₃')⟩"
    and "l⇩₂' = [this↦Ref(a,Cs'),pns[↦]vs']"
    by(auto elim:Casts_to.cases)
  ultimately have "P,E ⊢ ⟨(ref(a,Cs))∙M(map Val vs),s⟩ ⇒ ⟨e',(h⇩₃,l⇩₂)⟩"
    using body_case'
    by -(rule Call,simp_all)
  with s' id show ?case by simp
next
  case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a s s' e')
  have "P,E ⊢ ⟨ref(a,Cs),s⟩ ⇒ ⟨ref(a,Cs),s⟩" by (rule eval_evals.intros)
  moreover
  have finals: "finals(map Val vs)" by simp
  obtain h⇩₂ l⇩₂ where s: "s = (h⇩₂,l⇩₂)" by (cases s)
  with finals have "P,E ⊢ ⟨map Val vs,s⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩"
    by (iprover intro: eval_finalsId)
  moreover have path_unique:"P ⊢ Path last Cs to C unique" by fact
  moreover have path_via:"P ⊢ Path last Cs to C via Cs''" by fact
  moreover have least:"P ⊢ C has least M = (Ts, T, pns, body) via Cs'" by fact
  moreover have same_len⇩₁: "length Ts = length pns"
   and this_distinct: "this ∉ set pns" and fv: "fv body ⊆ {this} ∪ set pns"
    using least wf by (fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
  moreover have same_len:"length vs = length pns" by fact
  moreover have Ds:"Ds = (Cs @⇩_p Cs'') @⇩_p Cs'" by fact
  moreover
  obtain h⇩₃ l⇩₃ where s': "s' = (h⇩₃,l⇩₃)" by (cases s')
  have eval_blocks:"P,E ⊢ ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),s⟩
                       ⇒ ⟨e',s'⟩" by fact
  hence id: "l⇩₃ = l⇩₂" using fv s s' same_len⇩₁ same_len wf
    by(auto elim!: eval_closed_lcl_unchanged)
  from same_len⇩₁ have same_len':"length(this#pns) = length(Class (last Ds)#Ts)"
    by simp
  from same_len⇩₁ same_len
  have same_len⇩₂:"length(this#pns) = length(Ref(a,Ds)#vs)" by simp
  from eval_blocks
  have eval_blocks':"P,E ⊢ ⟨blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),
                               (h⇩₂,l⇩₂)⟩ ⇒ ⟨e',(h⇩₃,l⇩₃)⟩" using s s' by simp
  have casts_unique:"⋀vs'. P ⊢ Class (last Ds)#Ts Casts Ref(a,Ds)#vs to vs'
                            ⟹ vs' = Ref(a,Ds)#tl vs'"
    using wf
    by -(erule Casts_to.cases,auto elim!:casts_to.cases dest!:mdc_eq_last
                                      simp:path_via_def appendPath_def)
  from same_len' same_len⇩₂ eval_blocks' casts_unique
  obtain l'' vs' where body:"P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ 
               ⟨body,(h⇩₂,l⇩₂(this # pns[↦]Ref(a,Ds)#vs'))⟩ ⇒ ⟨e',(h⇩₃, l'')⟩"
    and casts:"P ⊢ Class(last Ds)#Ts Casts Ref(a,Ds)#vs to Ref(a,Ds)#vs'"
    and lengthvs':"length vs' = length vs"
    by -(drule_tac vs="Ref(a,Ds)#vs" in blocksEval,auto simp:length_Suc_conv,blast)
  from same_len⇩₂ lengthvs'
  have same_len⇩₃:"length (this # pns) = length (Ref(a,Ds) # vs')" by simp
  from restrict_map_upds[OF same_len⇩₃,of "set(this#pns)" "l⇩₂"]
  have "l⇩₂(this # pns[↦]Ref(a,Ds)#vs')|`(set(this#pns)) = 
          [this # pns[↦]Ref(a,Ds)#vs']" by simp
  with eval_restrict_lcl[OF wf body fv] this_distinct same_len⇩₁ same_len
  have "P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ 
   ⟨body,(h⇩₂,[this#pns [↦] Ref(a,Ds)#vs'])⟩ ⇒ ⟨e',(h⇩₃, l''|`(set(this#pns)))⟩"
    by simp
  with casts obtain l⇩₂' l⇩₃' vs' where
        "P ⊢ Ts Casts vs to vs'"
    and "P,E(this ↦ Class(last Ds),pns [↦] Ts) ⊢ ⟨body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨e',(h⇩₃,l⇩₃')⟩"
    and "l⇩₂' = [this ↦ Ref(a,Ds),pns [↦] vs']"
    by(auto elim:Casts_to.cases)
  ultimately have "P,E ⊢ ⟨(ref(a,Cs))∙(C::)M(map Val vs),s⟩ ⇒ ⟨e',(h⇩₃,l⇩₂)⟩"
    by -(rule StaticCall,simp_all)
  with s' id show ?case by simp
next
  case RedCallNull
  thus ?case
    by (fastforce elim: eval_cases intro: eval_evals.intros eval_finalsId)
next
  case BlockRedNone
  thus ?case
    by (fastforce elim!: eval_cases intro: eval_evals.intros 
                 simp add: fun_upd_same fun_upd_idem)
next
  case (BlockRedSome E V T e h l e'' h' l' v s' e')
  have eval:"P,E ⊢ ⟨{V:T:=Val v; e''},(h', l'(V := l V))⟩ ⇒ ⟨e',s'⟩"
    and red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e'',(h', l')⟩"
    and notassigned:"¬ assigned V e" and l':"l' V = Some v"
    and IH:"⋀ex sx. P,E(V ↦ T) ⊢ ⟨e'',(h', l')⟩ ⇒ ⟨ex,sx⟩ ⟹
                     P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ ⇒ ⟨ex,sx⟩" by fact+
  from l' have l'upd:"l'(V ↦ v) = l'" by (rule map_upd_triv)
  from wf red l' have casts:"P ⊢ T casts v to v"
    apply -
    apply(erule_tac V="V" in None_lcl_casts_values)
    by(simp add:fun_upd_same)+
  from eval obtain h'' l''
  where "P,E(V ↦ T) ⊢ ⟨V:=Val v;; e'',(h',l'(V:=None))⟩ ⇒ ⟨e',(h'',l'')⟩ ∧ 
    s' = (h'',l''(V:=l V))"
    by (fastforce elim:eval_cases simp:fun_upd_same fun_upd_idem)
  moreover
  { fix T' h⇩₀ l⇩₀ v' v''
    assume eval':"P,E(V ↦ T) ⊢ ⟨e'',(h⇩₀,l⇩₀(V ↦ v''))⟩ ⇒ ⟨e',(h'', l'')⟩"
      and val:"P,E(V ↦ T) ⊢ ⟨Val v,(h', l'(V := None))⟩ ⇒ ⟨Val v',(h⇩₀,l⇩₀)⟩"
      and env:"(E(V ↦ T)) V = Some T'" and casts':"P ⊢ T' casts v' to v''"
    from env have TeqT':"T = T'" by (simp add:fun_upd_same)
    from val have eq:"v = v' ∧ h' = h⇩₀ ∧ l'(V := None) = l⇩₀"
      by -(erule eval_cases,simp)
    with casts casts' wf TeqT' have "v = v''"
      by clarsimp(rule casts_casts_eq)
    with eq eval'
    have "P,E(V ↦ T) ⊢ ⟨e'',(h', l'(V ↦ v))⟩ ⇒ ⟨e',(h'', l'')⟩"
      by clarsimp }
  ultimately have "P,E(V ↦ T) ⊢ ⟨e'',(h',l'(V ↦ v))⟩ ⇒ ⟨e',(h'',l'')⟩" 
    and s':"s' = (h'',l''(V:=l V))"
    apply auto
    apply(erule eval_cases)
     apply(erule eval_cases) apply auto
    apply(erule eval_cases) apply auto
    apply(erule eval_cases) apply auto
    done
  with l'upd have eval'':"P,E(V ↦ T) ⊢ ⟨e'',(h',l')⟩ ⇒ ⟨e',(h'',l'')⟩"
    by simp
  from IH[OF eval''] have "P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ ⇒ ⟨e',(h'', l'')⟩" .
  with s' show ?case by(fastforce intro:Block)
next
  case (InitBlockRed E V T e h l v' e'' h' l' v'' v s' e')
  have eval:" P,E ⊢ ⟨{V:T:=Val v''; e''},(h', l'(V := l V))⟩ ⇒ ⟨e',s'⟩"
    and red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ → ⟨e'',(h', l')⟩"
    and casts:"P ⊢ T casts v to v'" and l':"l' V = Some v''"
    and IH:"⋀ex sx. P,E(V ↦ T) ⊢ ⟨e'',(h', l')⟩ ⇒ ⟨ex,sx⟩ ⟹
                     P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ ⇒ ⟨ex,sx⟩" by fact+
  from l' have l'upd:"l'(V ↦ v'') = l'" by (rule map_upd_triv)
  from wf casts have "P ⊢ T casts v' to v'" by(rule casts_casts)
  with wf red l' have casts':"P ⊢ T casts v'' to v''"
    apply -
    apply(erule_tac V="V" in Some_lcl_casts_values)
    by(simp add:fun_upd_same)+
  from eval obtain h'' l''
  where "P,E(V ↦ T) ⊢ ⟨V:=Val v'';; e'',(h',l'(V:=None))⟩ ⇒ ⟨e',(h'',l'')⟩ ∧ 
    s' = (h'',l''(V:=l V))"
    by (fastforce elim:eval_cases simp:fun_upd_same fun_upd_idem)
  moreover
  { fix T' v'''
    assume eval':"P,E(V ↦ T) ⊢ ⟨e'',(h',l'(V ↦ v'''))⟩ ⇒ ⟨e',(h'', l'')⟩"
      and env:"(E(V ↦ T)) V = Some T'" and casts'':"P ⊢ T' casts v'' to v'''"
    from env have "T = T'" by (simp add:fun_upd_same)
    with casts' casts'' wf have "v'' = v'''" by simp(rule casts_casts_eq)
    with eval' have "P,E(V ↦ T) ⊢ ⟨e'',(h', l'(V ↦ v''))⟩ ⇒ ⟨e',(h'', l'')⟩" by simp }
  ultimately have "P,E(V ↦ T) ⊢ ⟨e'',(h',l'(V ↦ v''))⟩ ⇒ ⟨e',(h'',l'')⟩"
    and s':"s' = (h'',l''(V:=l V))"
    by(auto elim!:eval_cases)
 with l'upd have eval'':"P,E(V ↦ T) ⊢ ⟨e'',(h',l')⟩ ⇒ ⟨e',(h'',l'')⟩"
    by simp
  from IH[OF eval'']
  have evale:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ ⇒ ⟨e',(h'', l'')⟩" .
  from casts
  have "P,E(V ↦ T) ⊢ ⟨V:=Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v',(h,l(V ↦ v'))⟩"
    by -(rule_tac l="l(V:=None)" in LAss,
         auto intro:eval_evals.intros simp:fun_upd_same)
  with evale s' show ?case by(fastforce intro:Block Seq)
next
  case (RedBlock E V T v s s' e')
  have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨e',s'⟩" by fact
  then obtain s': "s'=s" and e': "e'=Val v"
    by cases simp
  obtain h l where s: "s=(h,l)" by (cases s)
  have "P,E(V ↦ T) ⊢ ⟨Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v,(h,l(V:=None))⟩" 
    by (rule eval_evals.intros)
  hence "P,E ⊢ ⟨{V:T;Val v},(h,l)⟩ ⇒ ⟨Val v,(h,(l(V:=None))(V:=l V))⟩"
    by (rule eval_evals.Block)
  thus "P,E ⊢ ⟨{V:T; Val v},s⟩ ⇒ ⟨e',s'⟩"
    using s s' e'
    by simp
next
  case (RedInitBlock T v v' E V u s s' e')
  have "P,E ⊢ ⟨Val u,s⟩ ⇒ ⟨e',s'⟩" and casts:"P ⊢ T casts v to v'" by fact+
  then obtain s': "s' = s" and e': "e'=Val u" by cases simp
  obtain h l where s: "s=(h,l)" by (cases s)
  have val:"P,E(V ↦ T) ⊢ ⟨Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v,(h,l(V:=None))⟩"
    by (rule eval_evals.intros)
  with casts
  have "P,E(V ↦ T) ⊢ ⟨V:=Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v',(h,l(V ↦ v'))⟩"
    by -(rule_tac l="l(V:=None)" in LAss,auto simp:fun_upd_same)
  hence "P,E ⊢ ⟨{V:T :=Val v; Val u},(h,l)⟩ ⇒ ⟨Val u,(h, (l(V↦v'))(V:=l V))⟩"
    by (fastforce intro!: eval_evals.intros)
  thus ?case using s s' e' by simp
next
  case SeqRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedSeq thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case CondRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedCondT thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedCondF thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedWhile
  thus ?case by (auto simp add: unfold_while intro:eval_evals.intros elim:eval_cases)
next
  case ThrowRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case RedThrowNull
  thus ?case by -(auto elim!:eval_cases intro!:eval_evals.ThrowNull eval_finalId)
next
  case ListRed1 thus ?case by (fastforce elim: evals_cases intro: eval_evals.intros)
next
  case ListRed2
  thus ?case by (fastforce elim!: evals_cases eval_cases 
                          intro: eval_evals.intros eval_finalId)
next
  case StaticCastThrow
  thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case DynCastThrow
  thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case BinOpThrow1 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case BinOpThrow2 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case LAssThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case FAccThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case FAssThrow1 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case FAssThrow2 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case CallThrowObj thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case (CallThrowParams es vs r es' E v Copt M s s' e')
  have "P,E ⊢ ⟨Val v,s⟩ ⇒ ⟨Val v,s⟩" by (rule eval_evals.intros)
  moreover
  have es: "es = map Val vs @ Throw r # es'" by fact
  have eval_e: "P,E ⊢ ⟨Throw r,s⟩ ⇒ ⟨e',s'⟩" by fact
  then obtain s': "s' = s" and e': "e' = Throw r"
    by cases (auto elim!:eval_cases)
  with list_eval_Throw [OF eval_e] es
  have "P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs @ Throw r # es',s'⟩" by simp
  ultimately have "P,E ⊢ ⟨Call (Val v) Copt M es,s⟩ ⇒ ⟨Throw r,s'⟩"
    by (rule eval_evals.CallParamsThrow)
  thus ?case using e' by simp
next
  case (BlockThrow E V T r s s' e')
  have "P,E ⊢ ⟨Throw r, s⟩ ⇒ ⟨e',s'⟩" by fact
  then obtain s': "s' = s" and e': "e' = Throw r"
    by cases (auto elim!:eval_cases)
  obtain h l where s: "s=(h,l)" by (cases s)
  have "P,E(V ↦ T) ⊢ ⟨Throw r, (h,l(V:=None))⟩ ⇒ ⟨Throw r, (h,l(V:=None))⟩"
    by (simp add:eval_evals.intros eval_finalId)
  hence "P,E ⊢ ⟨{V:T;Throw r},(h,l)⟩ ⇒ ⟨Throw r, (h,(l(V:=None))(V:=l V))⟩"
    by (rule eval_evals.Block)
  thus "P,E ⊢ ⟨{V:T; Throw r},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
next
  case (InitBlockThrow T v v' E V r s s' e')
  have "P,E ⊢ ⟨Throw r,s⟩ ⇒ ⟨e',s'⟩" and casts:"P ⊢ T casts v to v'" by fact+
  then obtain s': "s' = s" and e': "e' = Throw r"
    by cases (auto elim!:eval_cases)
  obtain h l where s: "s = (h,l)" by (cases s)
  have "P,E(V ↦ T) ⊢ ⟨Val v,(h,l(V:=None))⟩ ⇒ ⟨Val v,(h,l(V:=None))⟩"
    by (rule eval_evals.intros)
  with casts
  have "P,E(V ↦ T) ⊢ ⟨V:=Val v,(h,l(V := None))⟩ ⇒ ⟨Val v',(h,l(V ↦ v'))⟩"
    by -(rule_tac l="l(V:=None)" in LAss,auto simp:fun_upd_same)
  hence "P,E ⊢ ⟨{V:T := Val v; Throw r},(h,l)⟩ ⇒ ⟨Throw r, (h, (l(V↦v'))(V:=l V))⟩"
    by(fastforce intro:eval_evals.intros)
  thus "P,E ⊢ ⟨{V:T := Val v; Throw r},s⟩ ⇒ ⟨e',s'⟩" using s s' e' by simp
next
  case SeqThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case CondThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
next
  case ThrowThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
qed


(* ... und wieder anschalten: *)
declare split_paired_All [simp] split_paired_Ex [simp]
setup ‹map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac))›
setup ‹map_theory_simpset (fn ctxt => ctxt addloop ("split_all_tac", split_all_tac))›


text ‹Its extension to ‹→*›:› 

lemma extend_eval:
assumes wf: "wwf_prog P"
and reds: "P,E ⊢ ⟨e,s⟩ →* ⟨e'',s''⟩" and eval_rest:  "P,E ⊢ ⟨e'',s''⟩ ⇒ ⟨e',s'⟩"
shows "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"

using reds eval_rest 
apply (induct rule: converse_rtrancl_induct2)
apply simp
apply simp
apply (rule extend_1_eval)
apply (rule wf)
apply assumption+
done



lemma extend_evals:
assumes wf: "wwf_prog P"
and reds: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es'',s''⟩" and eval_rest:  "P,E ⊢ ⟨es'',s''⟩ [⇒] ⟨es',s'⟩"
shows "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"

using reds eval_rest 
apply (induct rule: converse_rtrancl_induct2)
apply simp
apply simp
apply (rule extend_1_evals)
apply (rule wf)
apply assumption+
done


text ‹Finally, small step semantics can be simulated by big step semantics:
›

theorem
assumes wf: "wwf_prog P"
shows small_by_big: "⟦P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩; final e'⟧ ⟹ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩"
and "⟦P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩; finals es'⟧ ⟹ P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"

proof -
  note wf 
  moreover assume "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
  moreover assume "final e'"
  then have "P,E ⊢ ⟨e',s'⟩ ⇒ ⟨e',s'⟩"
    by (rule eval_finalId)
  ultimately show "P,E ⊢ ⟨e,s⟩⇒⟨e',s'⟩"
    by (rule extend_eval)
next
  note wf 
  moreover assume "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
  moreover assume "finals es'"
  then have "P,E ⊢ ⟨es',s'⟩ [⇒] ⟨es',s'⟩"
    by (rule eval_finalsId)
  ultimately show "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩"
    by (rule extend_evals)
qed


subsection ‹Equivalence›

text‹And now, the crowning achievement:›

corollary big_iff_small:
  "wwf_prog P ⟹
  P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩  =  (P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩ ∧ final e')"
by(blast dest: big_by_small eval_final small_by_big)


end

Theory Progress

(*  Title:       CoreC++

    Author:      Daniel Wasserrab
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>

    Based on the Jinja theory J/Progress.thy by Tobias Nipkow 
*)

section ‹Progress of Small Step Semantics›

theory Progress imports Equivalence DefAss Conform begin


subsection ‹Some pre-definitions›

lemma final_refE:
  "⟦ P,E,h ⊢ e : Class C; final e;
    ⋀r. e = ref r ⟹ Q;
    ⋀r. e = Throw r ⟹ Q ⟧ ⟹ Q"
by (simp add:final_def,auto,case_tac v,auto)


lemma finalRefE:
  "⟦ P,E,h ⊢ e : T; is_refT T; final e;
  e = null ⟹ Q;
  ⋀r. e = ref r ⟹ Q;
  ⋀r. e = Throw r ⟹ Q⟧ ⟹ Q"

apply (cases T)
apply (simp add:is_refT_def)+
 apply (simp add:final_def)
 apply (erule disjE)
  apply clarsimp
 apply (erule exE)+
apply fastforce
apply (auto simp:final_def is_refT_def)
apply (case_tac v)
apply auto
done


lemma subE:
  "⟦ P ⊢ T ≤ T'; is_type P T'; wf_prog wf_md P;
     ⟦ T = T'; ∀C. T ≠ Class C ⟧ ⟹ Q;
     ⋀C D. ⟦ T = Class C; T' = Class D; P ⊢ Path C to D unique ⟧ ⟹ Q;
     ⋀C. ⟦ T = NT; T' = Class C ⟧ ⟹ Q ⟧ ⟹ Q"

apply(cases T')
apply auto
apply(drule_tac T = "T" in widen_Class)
apply auto
done


lemma assumes wf:"wf_prog wf_md P"
  and typeof:" P ⊢ typeof⇘_h⇙ v = Some T'"
  and type:"is_type P T"
shows sub_casts:"P ⊢ T' ≤ T ⟹ ∃v'. P ⊢ T casts v to v'"

proof(erule subE)
  from type show "is_type P T" .
next
  from wf show "wf_prog wf_md P" .
next
  assume "T' = T" and "∀C. T' ≠ Class C"
  thus "∃v'. P ⊢ T casts v to v'" by(fastforce intro:casts_prim)
next
  fix C D
  assume T':"T' = Class C" and T:"T = Class D"
    and path_unique:"P ⊢ Path C to D unique"
  from T' typeof obtain a Cs where v:"v = Ref(a,Cs)" and last:"last Cs = C"
    by(auto dest!:typeof_Class_Subo)
  from last path_unique obtain Cs' where "P ⊢ Path last Cs to D via Cs'"
    by(auto simp:path_unique_def path_via_def)
  hence "P ⊢ Class D casts Ref(a,Cs) to Ref(a,Cs@⇩_pCs')"
    by -(rule casts_ref,simp_all)
  with T v show "∃v'. P ⊢ T casts v to v'" by auto
next
  fix C
  assume "T' = NT" and T:"T = Class C"
  with typeof have "v = Null" by simp
  with T show "∃v'. P ⊢ T casts v to v'" by(fastforce intro:casts_null)
qed



text‹Derivation of new induction scheme for well typing:›

inductive
  WTrt' :: "[prog,env,heap,expr,     ty     ] ⇒ bool"
        ("_,_,_ ⊢ _ :'' _"   [51,51,51]50)
  and WTrts':: "[prog,env,heap,expr list,ty list] ⇒ bool"
        ("_,_,_ ⊢ _ [:''] _" [51,51,51]50)
  for P :: prog
where
  "is_class P C ⟹  P,E,h ⊢ new C :' Class C"
| "⟦is_class P C; P,E,h ⊢ e :' T; is_refT T⟧ 
   ⟹ P,E,h ⊢ Cast C e :' Class C"
| "⟦is_class P C; P,E,h ⊢ e :' T; is_refT T⟧ 
   ⟹ P,E,h ⊢ ⦇C⦈e :' Class C"
| "P ⊢ typeof⇘_h⇙ v = Some T ⟹ P,E,h ⊢ Val v :' T"
| "E V = Some T  ⟹  P,E,h ⊢ Var V :' T"
| "⟦ P,E,h ⊢ e⇩₁ :' T⇩₁;  P,E,h ⊢ e⇩₂ :' T⇩₂;
    case bop of Eq ⇒ T = Boolean
    | Add ⇒ T⇩₁ = Integer ∧ T⇩₂ = Integer ∧ T = Integer ⟧
   ⟹ P,E,h ⊢ e⇩₁ «bop» e⇩₂ :' T"
| "⟦ P,E,h ⊢ Var V :' T; P,E,h ⊢ e :' T' ⌦‹V ≠ This›; P ⊢ T' ≤ T ⟧
   ⟹ P,E,h ⊢ V:=e :' T"
| "⟦P,E,h ⊢ e :' Class C; Cs ≠ []; P ⊢ C has least F:T via Cs⟧ 
  ⟹ P,E,h ⊢ e∙F{Cs} :' T"
| "P,E,h ⊢ e :' NT ⟹ P,E,h ⊢ e∙F{Cs} :' T"
| "⟦P,E,h ⊢ e⇩₁ :' Class C; Cs ≠ []; P ⊢ C has least F:T via Cs;
    P,E,h ⊢ e⇩₂ :' T'; P ⊢ T' ≤ T ⟧ 
  ⟹ P,E,h ⊢ e⇩₁∙F{Cs}:=e⇩₂ :' T"
| "⟦ P,E,h ⊢ e⇩₁:'NT; P,E,h ⊢ e⇩₂ :' T'; P ⊢ T' ≤ T ⟧ 
   ⟹ P,E,h ⊢ e⇩₁∙F{Cs}:=e⇩₂ :' T"
| "⟦ P,E,h ⊢ e :' Class C;  P ⊢ C has least M = (Ts,T,m) via Cs;
    P,E,h ⊢ es [:'] Ts'; P ⊢ Ts' [≤] Ts ⟧
    ⟹ P,E,h ⊢ e∙M(es) :' T" 
| "⟦ P,E,h ⊢ e :' Class C'; P ⊢ Path C' to C unique;
    P ⊢ C has least M = (Ts,T,m) via Cs; 
    P,E,h ⊢ es [:'] Ts'; P ⊢ Ts' [≤] Ts ⟧
    ⟹ P,E,h ⊢ e∙(C::)M(es) :' T"
| "⟦P,E,h ⊢ e :' NT; P,E,h ⊢ es [:'] Ts⟧ ⟹ P,E,h ⊢ Call e Copt M es :' T"
| "⟦ P ⊢ typeof⇘_h⇙ v = Some T'; P,E(V↦T),h ⊢ e⇩₂ :' T⇩₂; P ⊢ T' ≤ T; is_type P T ⟧
   ⟹  P,E,h ⊢ {V:T := Val v; e⇩₂} :' T⇩₂"
| "⟦ P,E(V↦T),h ⊢ e :' T'; ¬ assigned V e; is_type P T ⟧
   ⟹  P,E,h ⊢ {V:T; e} :' T'"
| "⟦ P,E,h ⊢ e⇩₁ :' T⇩₁; P,E,h ⊢ e⇩₂ :' T⇩₂ ⟧  ⟹  P,E,h ⊢ e⇩₁;;e⇩₂ :' T⇩₂"
| "⟦ P,E,h ⊢ e :' Boolean;  P,E,h ⊢ e⇩₁:' T;  P,E,h ⊢ e⇩₂:' T ⟧
   ⟹ P,E,h ⊢ if (e) e⇩₁ else e⇩₂ :' T"
| "⟦ P,E,h ⊢ e :' Boolean;  P,E,h ⊢ c:' T ⟧
   ⟹  P,E,h ⊢ while(e) c :' Void"
| "⟦ P,E,h ⊢ e :' T'; is_refT T'⟧  ⟹  P,E,h ⊢ throw e :' T"

| "P,E,h ⊢ [] [:'] []"
| "⟦ P,E,h ⊢ e :' T;  P,E,h ⊢ es [:'] Ts ⟧ ⟹  P,E,h ⊢ e#es [:'] T#Ts"



lemmas WTrt'_induct = WTrt'_WTrts'.induct [split_format (complete)]
  and WTrt'_inducts = WTrt'_WTrts'.inducts [split_format (complete)]

inductive_cases WTrt'_elim_cases[elim!]:
  "P,E,h ⊢ V :=e :' T"


text‹... and some easy consequences:›

lemma [iff]: "P,E,h ⊢ e⇩₁;;e⇩₂ :' T⇩₂ = (∃T⇩₁. P,E,h ⊢ e⇩₁:' T⇩₁ ∧ P,E,h ⊢ e⇩₂:' T⇩₂)"

apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done


lemma [iff]: "P,E,h ⊢ Val v :' T = (P ⊢ typeof⇘_h⇙ v = Some T)"

apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done


lemma [iff]: "P,E,h ⊢ Var V :' T = (E V = Some T)"

apply(rule iffI)
apply (auto elim: WTrt'.cases intro!:WTrt'_WTrts'.intros)
done



lemma wt_wt': "P,E,h ⊢ e : T ⟹ P,E,h ⊢ e :' T"
and wts_wts': "P,E,h ⊢ es [:] Ts ⟹ P,E,h ⊢ es [:'] Ts"

proof (induct rule:WTrt_inducts)
  case (WTrtBlock E V T h e T')
  thus ?case
    apply(case_tac "assigned V e")
    apply(auto intro:WTrt'_WTrts'.intros 
          simp add:fun_upd_same assigned_def simp del:fun_upd_apply)
    done
qed(auto intro:WTrt'_WTrts'.intros simp del:fun_upd_apply)


lemma wt'_wt: "P,E,h ⊢ e :' T ⟹ P,E,h ⊢ e : T"
and wts'_wts: "P,E,h ⊢ es [:'] Ts ⟹ P,E,h ⊢ es [:] Ts"

apply (induct rule:WTrt'_inducts)
apply (fastforce intro: WTrt_WTrts.intros)+
done



corollary wt'_iff_wt: "(P,E,h ⊢ e :' T) = (P,E,h ⊢ e : T)"
by(blast intro:wt_wt' wt'_wt)


corollary wts'_iff_wts: "(P,E,h ⊢ es [:'] Ts) = (P,E,h ⊢ es [:] Ts)"
by(blast intro:wts_wts' wts'_wts)

lemmas WTrt_inducts2 = WTrt'_inducts [unfolded wt'_iff_wt wts'_iff_wts,
  case_names WTrtNew WTrtDynCast WTrtStaticCast WTrtVal WTrtVar WTrtBinOp 
  WTrtLAss WTrtFAcc WTrtFAccNT WTrtFAss WTrtFAssNT WTrtCall WTrtStaticCall WTrtCallNT 
  WTrtInitBlock WTrtBlock WTrtSeq WTrtCond WTrtWhile WTrtThrow 
  WTrtNil WTrtCons, consumes 1]


subsection‹The theorem ‹progress››


lemma mdc_leq_dyn_type:
"P,E,h ⊢ e : T ⟹ 
  ∀C a Cs D S. T = Class C ∧ e = ref(a,Cs) ∧ h a = Some(D,S) ⟶ P ⊢ D ≼⇧^* C"
and "P,E,h ⊢ es [:] Ts ⟹
  ∀T Ts' e es' C a Cs D S. Ts = T#Ts' ∧ es = e#es' ∧ 
                           T = Class C ∧ e = ref(a,Cs) ∧ h a = Some(D,S)
      ⟶ P ⊢ D ≼⇧^* C"

proof (induct rule:WTrt_inducts2)
  case (WTrtVal h v T E)
  have type:"P ⊢ typeof⇘_h⇙ v = Some T" by fact
  { fix C a Cs D S
    assume "T = Class C" and "Val v = ref(a,Cs)" and "h a = Some(D,S)"
    with type have "Subobjs P D Cs" and "C = last Cs" by (auto split:if_split_asm)
    hence "P ⊢ D ≼⇧^* C" by simp (rule Subobjs_subclass) }
  thus ?case by blast
qed auto



lemma appendPath_append_last:
  assumes notempty:"Ds ≠ []" 
  shows"(Cs @⇩_p Ds) @⇩_p [last Ds] = (Cs @⇩_p Ds)"

proof -
  have "last Cs = hd Ds ⟹ last (Cs @ tl Ds) = last Ds"
  proof(cases "tl Ds = []")
    case True
    assume last:"last Cs = hd Ds"
    with True notempty have "Ds = [last Cs]" by (fastforce dest:hd_Cons_tl)
    hence "last Ds = last Cs" by simp
    with True show ?thesis by simp
  next
    case False
    assume last:"last Cs = hd Ds"
    from notempty False have "last (tl Ds) = last Ds"
      by -(drule hd_Cons_tl,drule_tac x="hd Ds" in last_ConsR,simp)
    with False show ?thesis by simp
  qed
  thus ?thesis by(simp add:appendPath_def)
qed




theorem assumes wf: "wwf_prog P"
shows progress: "P,E,h ⊢ e : T ⟹
 (⋀l. ⟦ P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e ⟧ ⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩)"
and "P,E,h ⊢ es [:] Ts ⟹
 (⋀l. ⟦ P ⊢ h √; P ⊢ E √; 𝒟s es ⌊dom l⌋; ¬ finals es ⟧ ⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩)"
proof (induct rule:WTrt_inducts2)
  case (WTrtNew C E h)
  show ?case
  proof cases
    assume "∃a. h a = None"
    with WTrtNew show ?thesis
      by (fastforce del:exE intro!:RedNew simp:new_Addr_def)
  next
    assume "¬(∃a. h a = None)"
    with WTrtNew show ?thesis
      by(fastforce intro:RedNewFail simp add:new_Addr_def)
  qed
next
  case (WTrtDynCast C E h e T)
  have wte: "P,E,h ⊢ e : T" and refT: "is_refT T" and "class": "is_class P C"
    and IH: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
                ⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
    and D: "𝒟 (Cast C e) ⌊dom l⌋" 
    and hconf: "P ⊢ h √" and envconf:"P ⊢ E √" by fact+
  from D have De: "𝒟 e ⌊dom l⌋" by auto
  show ?case
  proof cases
    assume "final e"
    with wte refT show ?thesis
    proof (rule finalRefE)
      assume "e = null" thus ?case by(fastforce intro:RedDynCastNull)
    next
      fix r assume "e = ref r"
      then obtain a Cs where ref:"e = ref(a,Cs)" by (cases r) auto
      with wte obtain D S where h:"h a = Some(D,S)" by auto
      show ?thesis
      proof (cases "P ⊢ Path D to C unique")
        case True
        then obtain Cs' where path:"P ⊢ Path D to C via Cs'"
          by (fastforce simp:path_via_def path_unique_def)
        then obtain Ds where "Ds = appendPath Cs Cs'" by simp
        with h path True ref show ?thesis by (fastforce intro:RedDynCast)
      next
        case False
        hence path_not_unique:"¬ P ⊢ Path D to C unique" .
        show ?thesis
        proof(cases "P ⊢ Path last Cs to C unique")
          case True
          then obtain Cs' where "P ⊢ Path last Cs to C via Cs'"
            by(auto simp:path_via_def path_unique_def)
          with True ref show ?thesis by(fastforce intro:RedStaticUpDynCast)
        next
          case False
          hence path_not_unique':"¬ P ⊢ Path last Cs to C unique" .
          thus ?thesis
          proof(cases "C ∉ set Cs")
            case False
            then obtain Ds Ds' where "Cs = Ds@[C]@Ds'"
              by (auto simp:in_set_conv_decomp)
            with ref show ?thesis by(fastforce intro:RedStaticDownDynCast)
          next
            case True
            with path_not_unique path_not_unique' h ref 
            show ?thesis by (fastforce intro:RedDynCastFail)
          qed
        qed
      qed
    next
      fix r assume "e = Throw r"
      thus ?thesis by(blast intro!:red_reds.DynCastThrow)
    qed
  next
    assume nf: "¬ final e"
    from IH[OF hconf envconf De nf] show ?thesis by (blast intro:DynCastRed)
  qed
next
  case (WTrtStaticCast C E h e T)
  have wte: "P,E,h ⊢ e : T" and refT: "is_refT T" and "class": "is_class P C"
   and IH: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
                ⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
   and D: "𝒟 (⦇C⦈e) ⌊dom l⌋" 
    and hconf: "P ⊢ h √" and envconf:"P ⊢ E √" by fact+
  from D have De: "𝒟 e ⌊dom l⌋" by auto
  show ?case
  proof cases
    assume "final e"
    with wte refT show ?thesis
    proof (rule finalRefE)
      assume "e = null" with "class" show ?case by(fastforce intro:RedStaticCastNull)
    next
      fix r assume "e = ref r"
      then obtain a Cs where ref:"e = ref(a,Cs)" by (cases r) auto
      with wte wf have "class":"is_class P (last Cs)" 
        by (auto intro:Subobj_last_isClass split:if_split_asm)
      show ?thesis
      proof(cases "P ⊢ (last Cs) ≼⇧^* C")
        case True
        with "class" wf obtain Cs'  where "P ⊢ Path last Cs to C via Cs'"
          by(fastforce dest:leq_implies_path)
        with True ref show ?thesis by(fastforce intro:RedStaticUpCast)
      next
        case False
        have notleq:"¬ P ⊢ last Cs ≼⇧^* C" by fact
        thus ?thesis
        proof(cases "C ∉ set Cs")
          case False
          then obtain Ds Ds' where "Cs = Ds@[C]@Ds'"
            by (auto simp:in_set_conv_decomp)
          with ref show ?thesis
            by(fastforce intro:RedStaticDownCast)
        next
          case True
          with ref notleq show ?thesis by (fastforce intro:RedStaticCastFail)
        qed
      qed
    next
      fix r assume "e = Throw r"
      thus ?thesis by(blast intro!:red_reds.StaticCastThrow)
    qed
  next
    assume nf: "¬ final e"
    from IH[OF hconf envconf De nf] show ?thesis by (blast intro:StaticCastRed)
  qed
next
  case WTrtVal thus ?case by(simp add:final_def)
next
  case WTrtVar thus ?case by(fastforce intro:RedVar simp:hyper_isin_def)
next
  case (WTrtBinOp E h e1 T1 e2 T2 bop T')
  have bop:"case bop of Eq ⇒ T' = Boolean
                      | Add ⇒ T1 = Integer ∧ T2 = Integer ∧ T' = Integer"
    and wte1:"P,E,h ⊢ e1 : T1" and wte2:"P,E,h ⊢ e2 : T2" by fact+
  show ?case
  proof cases
    assume "final e1"
    thus ?thesis
    proof (rule finalE)
      fix v1 assume e1 [simp]:"e1 = Val v1"
      show ?thesis
      proof cases
        assume "final e2"
        thus ?thesis
        proof (rule finalE)
          fix v2 assume e2 [simp]:"e2 = Val v2"
          show ?thesis
          proof (cases bop)
            assume "bop = Eq"
            thus ?thesis using WTrtBinOp by(fastforce intro:RedBinOp)
          next
            assume Add:"bop = Add"
            with e1 e2 wte1 wte2 bop obtain i1 i2 
              where "v1 = Intg i1" and "v2 = Intg i2"
              by (auto dest!:typeof_Integer)
            with Add obtain v where "binop(bop,v1,v2) = Some v" by simp
            with e1 e2 show ?thesis by (fastforce intro:RedBinOp)
          qed
        next
          fix a assume "e2 = Throw a"
          thus ?thesis by(auto intro:red_reds.BinOpThrow2)
        qed
      next
        assume "¬ final e2" with WTrtBinOp show ?thesis
          by simp (fast intro!:BinOpRed2)
      qed
    next
      fix r assume "e1 = Throw r"
      thus ?thesis by simp (fast intro:red_reds.BinOpThrow1)
    qed
  next
    assume "¬ final e1" with WTrtBinOp show ?thesis
      by simp (fast intro:BinOpRed1)
  qed
next
  case (WTrtLAss E h V T e T')
  have wte:"P,E,h ⊢ e : T'"
    and wtvar:"P,E,h ⊢ Var V : T"
    and sub:"P ⊢ T' ≤ T"
    and envconf:"P ⊢ E √" by fact+
  from envconf wtvar have type:"is_type P T" by(auto simp:envconf_def)
  show ?case
  proof cases
    assume fin:"final e"
    from fin show ?case
    proof (rule finalE)
      fix v assume e:"e = Val v"
      from sub type wf show ?case
      proof(rule subE)
        assume eq:"T' = T" and "∀C. T' ≠ Class C"
        hence "P ⊢ T casts v to v"
          by simp(rule casts_prim)
        with wte wtvar eq e show ?thesis
          by(auto intro!:RedLAss)
      next
        fix C D
        assume T':"T' = Class C" and T:"T = Class D"
          and path_unique:"P ⊢ Path C to D unique"
        from wte e T' obtain a Cs where ref:"e = ref(a,Cs)"
          and last:"last Cs = C" 
          by (auto dest!:typeof_Class_Subo)
        from path_unique obtain Cs' where path_via:"P ⊢ Path C to D via Cs'"
          by(auto simp:path_unique_def path_via_def)
        with last have "P ⊢ Class D casts Ref(a,Cs) to Ref(a,Cs@⇩_pCs')"
          by (fastforce intro:casts_ref simp:path_via_def)
        with wte wtvar T ref show ?thesis
          by(auto intro!:RedLAss)
      next
        fix C
        assume T':"T' = NT" and T:"T = Class C"
        with wte e have null:"e = null" by auto
        have "P ⊢ Class C casts Null to Null"
          by -(rule casts_null)
        with wte wtvar T null show ?thesis
          by(auto intro!:RedLAss)
      qed
    next
      fix r assume "e = Throw r"
      thus ?thesis by(fastforce intro:red_reds.LAssThrow)
    qed
  next
    assume "¬ final e" with WTrtLAss show ?thesis
      by simp (fast intro:LAssRed)
  qed
next
  case (WTrtFAcc E h e C Cs F T)
  have wte: "P,E,h ⊢ e : Class C" 
    and field: "P ⊢ C has least F:T via Cs"
    and notemptyCs:"Cs ≠ []"
    and hconf: "P ⊢ h √" by fact+
  show ?case
  proof cases
    assume "final e"
    with wte show ?thesis
    proof (rule final_refE)
      fix r assume e: "e = ref r"
      then obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
      with wte obtain D S where h:"h a = Some(D,S)" and suboD:"Subobjs P D Cs'"
        and last:"last Cs' = C"
        by (fastforce split:if_split_asm)
      from field obtain Bs fs ms
        where "class": "class P (last Cs) = Some(Bs,fs,ms)"
        and fs:"map_of fs F = Some T"
        by (fastforce simp:LeastFieldDecl_def FieldDecls_def)
      obtain Ds where Ds:"Ds = Cs'@⇩_pCs" by simp
      with notemptyCs "class" have class':"class P (last Ds) = Some(Bs,fs,ms)"
        by (drule_tac Cs'="Cs'" in appendPath_last) simp
      from field suboD last Ds wf have subo:"Subobjs P D Ds"
        by(fastforce intro:Subobjs_appendPath simp:LeastFieldDecl_def FieldDecls_def)
      with hconf h have "P,h ⊢ (D,S) √" by (auto simp:hconf_def)
      with class' subo obtain fs' where S:"(Ds,fs') ∈ S"
        and "P,h ⊢ fs' (:≤) map_of fs"
        apply (auto simp:oconf_def)
        apply (erule_tac x="Ds" in allE)
        apply auto
        apply (erule_tac x="Ds" in allE)
        apply (erule_tac x="fs'" in allE)
        apply auto
        done
      with fs obtain v where "fs' F = Some v"
        by (fastforce simp:fconf_def)
      with h last Ds S
      have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}, (h,l)⟩ → ⟨Val v,(h,l)⟩"
        by (fastforce intro:RedFAcc)
      with ref show ?thesis by blast
    next
      fix r assume "e = Throw r"
      thus ?thesis by(fastforce intro:red_reds.FAccThrow)
    qed
  next
    assume "¬ final e" with WTrtFAcc show ?thesis
      by(fastforce intro!:FAccRed)
  qed
next
  case (WTrtFAccNT E h e F Cs T)
  show ?case
  proof cases
    assume "final e"  ― ‹@{term e} is @{term null} or @{term throw}›
    with WTrtFAccNT show ?thesis
      by(fastforce simp:final_def intro: RedFAccNull red_reds.FAccThrow 
                  dest!:typeof_NT)
  next
    assume "¬ final e" ― ‹@{term e} reduces by IH›
    with WTrtFAccNT show ?thesis by simp (fast intro:FAccRed)
  qed
next
  case (WTrtFAss E h e⇩₁ C Cs F T e⇩₂ T')
  have wte1:"P,E,h ⊢ e⇩₁ : Class C"
    and wte2:"P,E,h ⊢ e⇩₂ : T'"
    and field:"P ⊢ C has least F:T via Cs" 
    and notemptyCs:"Cs ≠ []"
    and sub:"P ⊢ T' ≤ T"
    and hconf:"P ⊢ h √" by fact+
  from field wf have type:"is_type P T" by(rule least_field_is_type)
  show ?case
  proof cases
    assume "final e⇩₁"
    with wte1 show ?thesis
    proof (rule final_refE)
      fix r assume e1: "e⇩₁ = ref r"
      show ?thesis
      proof cases
        assume "final e⇩₂"
        thus ?thesis
        proof (rule finalE)
          fix v assume e2:"e⇩₂ = Val v"
          from e1 obtain a Cs' where ref:"e⇩₁ = ref(a,Cs')" by (cases r) auto
          with wte1 obtain D S where h:"h a = Some(D,S)" 
            and suboD:"Subobjs P D Cs'" and last:"last Cs' = C"
            by (fastforce split:if_split_asm)
          from field obtain Bs fs ms
            where "class": "class P (last Cs) = Some(Bs,fs,ms)"
            and fs:"map_of fs F = Some T"
            by (fastforce simp:LeastFieldDecl_def FieldDecls_def)
          obtain Ds where Ds:"Ds = Cs'@⇩_pCs" by simp
          with notemptyCs "class" have class':"class P (last Ds) = Some(Bs,fs,ms)"
            by (drule_tac Cs'="Cs'" in appendPath_last) simp
          from field suboD last Ds wf have subo:"Subobjs P D Ds"
            by(fastforce intro:Subobjs_appendPath 
              simp:LeastFieldDecl_def FieldDecls_def)
          with hconf h have "P,h ⊢ (D,S) √" by (auto simp:hconf_def)
          with class' subo obtain fs' where S:"(Ds,fs') ∈ S"
            by (auto simp:oconf_def)
          from sub type wf show ?thesis
          proof(rule subE)
            assume eq:"T' = T" and "∀C. T' ≠ Class C"
            hence "P ⊢ T casts v to v"
              by simp(rule casts_prim)
            with h last field Ds notemptyCs S eq
            have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ → 
              ⟨Val v, (h(a ↦ (D,insert (Ds,fs'(F↦v)) (S -  {(Ds,fs')}))),l)⟩"
              by (fastforce intro:RedFAss)
            with ref e2 show ?thesis by blast
          next
            fix C' D'
            assume T':"T' = Class C'" and T:"T = Class D'"
            and path_unique:"P ⊢ Path C' to D' unique"
            from wte2 e2 T' obtain a' Cs'' where ref2:"e⇩₂ = ref(a',Cs'')"
              and last':"last Cs'' = C'"
              by (auto dest!:typeof_Class_Subo)
            from path_unique obtain Ds' where "P ⊢ Path C' to D' via Ds'"
              by(auto simp:path_via_def path_unique_def)
            with last' 
            have casts:"P ⊢ Class D' casts Ref(a',Cs'') to Ref(a',Cs''@⇩_pDs')"
              by (fastforce intro:casts_ref simp:path_via_def)
            obtain v' where "v' = Ref(a',Cs''@⇩_pDs')" by simp
            with h last field Ds notemptyCs S ref e2 ref2 T casts
            have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ → 
                        ⟨Val v',(h(a ↦ (D,insert (Ds,fs'(F↦v'))(S-{(Ds,fs')}))),l)⟩"
              by (fastforce intro:RedFAss)
            with ref e2 show ?thesis by blast
          next
            fix C'
            assume T':"T' = NT" and T:"T = Class C'"
            from e2 wte2 T' have null:"e⇩₂ = null" by auto
            have casts:"P ⊢ Class C' casts Null to Null"
              by -(rule casts_null)
            obtain v' where "v' = Null" by simp
            with h last field Ds notemptyCs S ref e2 null T casts
            have "P,E ⊢ ⟨(ref (a,Cs'))∙F{Cs}:=(Val v), (h,l)⟩ → 
                  ⟨Val v', (h(a ↦ (D,insert (Ds,fs'(F↦v')) (S -  {(Ds,fs')}))),l)⟩"
              by (fastforce intro:RedFAss)
            with ref e2 show ?thesis by blast
          qed
        next
          fix r assume "e⇩₂ = Throw r"
          thus ?thesis using e1 by(fastforce intro:red_reds.FAssThrow2)
        qed
      next
        assume "¬ final e⇩₂" with WTrtFAss e1 show ?thesis
          by simp (fast intro!:FAssRed2)
      qed
    next
      fix r assume "e⇩₁ = Throw r"
      thus ?thesis by(fastforce intro:red_reds.FAssThrow1)
    qed
  next
    assume "¬ final e⇩₁" with WTrtFAss show ?thesis
      by simp (blast intro!:FAssRed1)
  qed
next
  case (WTrtFAssNT E h e⇩₁ e⇩₂ T' T F Cs)
  show ?case
  proof cases
    assume e1: "final e⇩₁"  ― ‹@{term e⇩₁} is @{term null} or @{term throw}›
    show ?thesis
    proof cases
      assume "final e⇩₂"  ― ‹@{term e⇩₂} is @{term Val} or @{term throw}›
      with WTrtFAssNT e1 show ?thesis
        by(fastforce simp:final_def intro:RedFAssNull red_reds.FAssThrow1 
                                         red_reds.FAssThrow2 dest!:typeof_NT)
    next
      assume  "¬ final e⇩₂" ― ‹@{term e⇩₂} reduces by IH›
      with WTrtFAssNT e1 show ?thesis
        by (fastforce simp:final_def intro!:red_reds.FAssRed2 red_reds.FAssThrow1)
    qed
  next
    assume "¬ final e⇩₁" ― ‹@{term e⇩₁} reduces by IH›
    with WTrtFAssNT show ?thesis by (fastforce intro:FAssRed1)
  qed
next
  case (WTrtCall E h e C M Ts T pns body Cs es Ts')
  have wte: "P,E,h ⊢ e : Class C"
    and "method":"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
    and wtes: "P,E,h ⊢ es [:] Ts'"and sub: "P ⊢ Ts' [≤] Ts"
    and IHes: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟s es ⌊dom l⌋; ¬ finals es⟧
             ⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩"
    and hconf: "P ⊢ h √" and envconf:"P ⊢ E √" 
    and D: "𝒟 (e∙M(es)) ⌊dom l⌋" by fact+
  show ?case
  proof cases
    assume final:"final e"
    with wte show ?thesis
    proof (rule final_refE)
      fix r assume ref: "e = ref r"
      show ?thesis
      proof cases
        assume es: "∃vs. es = map Val vs"
        from ref obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
        with wte obtain D S where h:"h a = Some(D,S)" and suboD:"Subobjs P D Cs'"
          and last:"last Cs' = C"
          by (fastforce split:if_split_asm)
        from wte ref h have subcls:"P ⊢ D ≼⇧^* C" by -(drule mdc_leq_dyn_type,auto)
        from "method" have has:"P ⊢ C has M = (Ts,T,pns,body) via Cs"
            by(rule has_least_method_has_method)
        from es obtain vs where vs:"es = map Val vs" by auto
        obtain Cs'' Ts'' T' pns' body' where 
          ass:"P ⊢ (D,Cs'@⇩_pCs) selects M = (Ts'',T',pns',body') via Cs'' ∧
           length Ts'' = length pns' ∧ length vs = length pns' ∧ P ⊢ T' ≤ T"
        proof (cases "∃Ts'' T' pns' body' Ds. P ⊢ D has least M = (Ts'',T',pns',body') via Ds")
          case True
          then obtain Ts'' T' pns' body' Cs'' 
            where least:"P ⊢ D has least M = (Ts'',T',pns',body') via Cs''"
            by auto
          hence select:"P ⊢ (D,Cs'@⇩_pCs) selects M = (Ts'',T',pns',body') via Cs''"
            by(rule dyn_unique)
          from subcls least wf has have "Ts = Ts''" and leq:"P ⊢ T' ≤ T"
            by -(drule leq_method_subtypes,simp_all,blast)+
          hence "length Ts = length Ts''" by (simp add:list_all2_iff)
          with sub have "length Ts' = length Ts''" by (simp add:list_all2_iff)
          with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts''"
            by simp
          from has_least_wf_mdecl[OF wf least] 
          have lengthParams:"length Ts'' = length pns'" by (simp add:wf_mdecl_def)
          with length have "length vs = length pns'" by simp
          with select lengthParams leq show ?thesis using that by blast
        next
          case False
          hence non_dyn:"∀Ts'' T' pns' body' Ds. 
              ¬ P ⊢ D has least M = (Ts'',T',pns',body') via Ds" by auto
          from suboD last have path:"P ⊢ Path D to C via Cs'" 
            by(simp add:path_via_def)
          from "method" have notempty:"Cs ≠ []" 
            by(fastforce intro!:Subobjs_nonempty 
                        simp:LeastMethodDef_def MethodDefs_def)
          from suboD have "class": "is_class P D" by(rule Subobjs_isClass)
          from suboD last have path:"P ⊢ Path D to C via Cs'"
            by(simp add:path_via_def)
          with "method" wf have "P ⊢ D has M = (Ts,T,pns,body) via Cs'@⇩_pCs"
            by(auto intro:has_path_has has_least_method_has_method)
          with "class" wf obtain Cs'' Ts'' T' pns' body' where overrider:
            "P ⊢ (D,Cs'@⇩_pCs) has overrider M = (Ts'',T',pns',body') via Cs''"
            by(auto dest!:class_wf simp:is_class_def wf_cdecl_def,blast)
          with non_dyn
          have select:"P ⊢ (D,Cs'@⇩_pCs) selects M = (Ts'',T',pns',body') via Cs''"
            by-(rule dyn_ambiguous,simp_all)
          from notempty have eq:"(Cs' @⇩_p Cs) @⇩_p [last Cs] = (Cs' @⇩_p Cs)"
            by(rule appendPath_append_last)
          from "method" wf
          have "P ⊢ last Cs has least M = (Ts,T,pns,body) via [last Cs]"
            by(auto dest:Subobj_last_isClass intro:Subobjs_Base subobjs_rel
                    simp:LeastMethodDef_def MethodDefs_def)
          with notempty
          have "P ⊢ last(Cs'@⇩_pCs) has least M = (Ts,T,pns,body) via [last Cs]"
            by -(drule_tac Cs'="Cs'" in appendPath_last,simp)
          with overrider wf eq
          have "(Cs'',(Ts'',T',pns',body')) ∈ MinimalMethodDefs P D M"
            and "P,D ⊢ Cs'' ⊑ Cs'@⇩_pCs"
            by(auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def)
              (drule wf_sees_method_fun,auto)
          with subcls wf notempty has path have "Ts = Ts''" and leq:"P ⊢ T' ≤ T"
            by -(drule leq_methods_subtypes,simp_all,blast)+
          hence "length Ts = length Ts''" by (simp add:list_all2_iff)
          with sub have "length Ts' = length Ts''" by (simp add:list_all2_iff)
          with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts''"
            by simp
          from select_method_wf_mdecl[OF wf select]
          have lengthParams:"length Ts'' = length pns'" by (simp add:wf_mdecl_def)
          with length have "length vs = length pns'" by simp
          with select lengthParams leq show ?thesis using that by blast
        qed
        obtain new_body where "case T of Class D ⇒ 
           new_body = ⦇D⦈blocks(this#pns',Class(last Cs'')#Ts'',Ref(a,Cs'')#vs,body')
    | _ ⇒ new_body = blocks(this#pns',Class(last Cs'')#Ts'',Ref(a,Cs'')#vs,body')"
          by(cases T) auto
        with h "method" last ass ref vs
          show ?thesis by (auto intro!:exI RedCall)
      next
        assume "¬(∃vs. es = map Val vs)"
        hence not_all_Val: "¬(∀e ∈ set es. ∃v. e = Val v)"
          by(simp add:ex_map_conv)
        let ?ves = "takeWhile (λe. ∃v. e = Val v) es"
        let ?rest = "dropWhile (λe. ∃v. e = Val v) es"
        let ?ex = "hd ?rest" let ?rst = "tl ?rest"
        from not_all_Val have nonempty: "?rest ≠ []" by auto
        hence es: "es = ?ves @ ?ex # ?rst" by simp
        have "∀e ∈ set ?ves. ∃v. e = Val v" by(fastforce dest:set_takeWhileD)
        then obtain vs where ves: "?ves = map Val vs"
          using ex_map_conv by blast
        show ?thesis
        proof cases
          assume "final ?ex"
          moreover from nonempty have "¬(∃v. ?ex = Val v)"
            by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
              (simp add:dropWhile_eq_Cons_conv)
          ultimately obtain r' where ex_Throw: "?ex = Throw r'"
            by(fast elim!:finalE)
          show ?thesis using ref es ex_Throw ves
            by(fastforce intro:red_reds.CallThrowParams)
        next
          assume not_fin: "¬ final ?ex"
          have "finals es = finals(?ves @ ?ex # ?rst)" using es
            by(rule arg_cong)
          also have "… = finals(?ex # ?rst)" using ves by simp
          finally have "finals es = finals(?ex # ?rst)" .
          hence "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
          thus ?thesis using ref D IHes[OF hconf envconf]
            by(fastforce intro!:CallParams)
        qed
      qed
    next
      fix r assume "e = Throw r"
      with WTrtCall.prems show ?thesis by(fast intro!:red_reds.CallThrowObj)
    qed
  next
    assume "¬ final e"
    with WTrtCall show ?thesis by simp (blast intro!:CallObj)
  qed
next
  case (WTrtStaticCall E h e C' C M Ts T pns body Cs es Ts')
  have wte: "P,E,h ⊢ e : Class C'"
    and path_unique:"P ⊢ Path C' to C unique"
    and "method":"P ⊢ C has least M = (Ts, T, pns, body) via Cs"
    and wtes: "P,E,h ⊢ es [:] Ts'"and sub: "P ⊢ Ts' [≤] Ts"
    and IHes: "⋀l.
              ⟦P ⊢ h √; envconf P E; 𝒟s es ⌊dom l⌋; ¬ finals es⟧
              ⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩"
    and hconf: "P ⊢ h √" and envconf:"envconf P E"
    and D: "𝒟 (e∙(C::)M(es)) ⌊dom l⌋" by fact+
  show ?case
  proof cases
    assume final:"final e"
    with wte show ?thesis
    proof (rule final_refE)
      fix r assume ref: "e = ref r"
      show ?thesis
      proof cases
        assume es: "∃vs. es = map Val vs"
        from ref obtain a Cs' where ref:"e = ref(a,Cs')" by (cases r) auto
        with wte have last:"last Cs' = C'"
          by (fastforce split:if_split_asm)
        with path_unique obtain Cs''
          where path_via:"P ⊢ Path (last Cs') to C via Cs''"
          by (auto simp add:path_via_def path_unique_def)
        obtain Ds where Ds:"Ds = (Cs'@⇩_pCs'')@⇩_pCs" by simp
        from es obtain vs where vs:"es = map Val vs" by auto
        from sub have "length Ts' = length Ts" by (simp add:list_all2_iff)
        with WTrts_same_length[OF wtes] vs have length:"length vs = length Ts"
          by simp
        from has_least_wf_mdecl[OF wf "method"]
        have lengthParams:"length Ts = length pns" by (simp add:wf_mdecl_def)
        with "method" last path_unique path_via Ds length ref vs show ?thesis
          by (auto intro!:exI RedStaticCall)
      next
        assume "¬(∃vs. es = map Val vs)"
        hence not_all_Val: "¬(∀e ∈ set es. ∃v. e = Val v)"
          by(simp add:ex_map_conv)
        let ?ves = "takeWhile (λe. ∃v. e = Val v) es"
        let ?rest = "dropWhile (λe. ∃v. e = Val v) es"
        let ?ex = "hd ?rest" let ?rst = "tl ?rest"
        from not_all_Val have nonempty: "?rest ≠ []" by auto
        hence es: "es = ?ves @ ?ex # ?rst" by simp
        have "∀e ∈ set ?ves. ∃v. e = Val v" by(fastforce dest:set_takeWhileD)
        then obtain vs where ves: "?ves = map Val vs"
          using ex_map_conv by blast
        show ?thesis
        proof cases
          assume "final ?ex"
          moreover from nonempty have "¬(∃v. ?ex = Val v)"
            by(auto simp:neq_Nil_conv simp del:dropWhile_eq_Nil_conv)
              (simp add:dropWhile_eq_Cons_conv)
          ultimately obtain r' where ex_Throw: "?ex = Throw r'"
            by(fast elim!:finalE)
          show ?thesis using ref es ex_Throw ves
            by(fastforce intro:red_reds.CallThrowParams)
        next
          assume not_fin: "¬ final ?ex"
          have "finals es = finals(?ves @ ?ex # ?rst)" using es
            by(rule arg_cong)
          also have "… = finals(?ex # ?rst)" using ves by simp
          finally have "finals es = finals(?ex # ?rst)" .
          hence "¬ finals es" using not_finals_ConsI[OF not_fin] by blast
          thus ?thesis using ref D IHes[OF hconf envconf]
            by(fastforce intro!:CallParams)
        qed
      qed
    next
      fix r assume "e = Throw r"
      with WTrtStaticCall.prems show ?thesis by(fast intro!:red_reds.CallThrowObj)
    qed
  next
    assume "¬ final e"
    with WTrtStaticCall show ?thesis by simp (blast intro!:CallObj)
  qed
next
  case (WTrtCallNT E h e es Ts Copt M T)
  show ?case
  proof cases
    assume "final e"
    moreover
    { fix v assume e: "e = Val v"
      hence "e = null" using WTrtCallNT by simp
      have ?case
      proof cases
        assume "finals es"
        moreover
        { fix vs assume "es = map Val vs"
          with WTrtCallNT e have ?thesis by(fastforce intro: RedCallNull dest!:typeof_NT) }
        moreover
        { fix vs a es' assume "es = map Val vs @ Throw a # es'"
          with WTrtCallNT e have ?thesis by(fastforce intro: CallThrowParams) }
        ultimately show ?thesis by(fastforce simp:finals_def)
      next
        assume "¬ finals es" ― ‹@{term es} reduces by IH›
        with WTrtCallNT e show ?thesis by(fastforce intro: CallParams)
      qed
    }
    moreover
    { fix r assume "e = Throw r"
      with WTrtCallNT have ?case by(fastforce intro: CallThrowObj) }
    ultimately show ?thesis by(fastforce simp:final_def)
  next
    assume "¬ final e" ― ‹@{term e} reduces by IH›
    with WTrtCallNT show ?thesis by (fastforce intro:CallObj)
  qed
next
  case (WTrtInitBlock h v T' E V T e⇩₂ T⇩₂)
  have IH2: "⋀l. ⟦P ⊢ h √; P ⊢ E(V ↦ T) √; 𝒟 e⇩₂ ⌊dom l⌋; ¬ final e⇩₂⟧
                  ⟹ ∃e' s'. P,E(V ↦ T) ⊢ ⟨e⇩₂,(h,l)⟩ → ⟨e',s'⟩"
    and typeof:"P ⊢ typeof⇘_h⇙ v = Some T'"
    and type:"is_type P T" and sub:"P ⊢ T' ≤ T"
    and hconf: "P ⊢ h √" and envconf:"P ⊢ E √"
    and D: "𝒟 {V:T := Val v; e⇩₂} ⌊dom l⌋" by fact+
  from wf typeof type sub obtain v' where casts:"P ⊢ T casts v to v'"
    by(auto dest:sub_casts)
  show ?case
  proof cases
    assume fin:"final e⇩₂"
    with casts show ?thesis
      by(fastforce elim:finalE intro:RedInitBlock red_reds.InitBlockThrow)
  next
    assume not_fin2: "¬ final e⇩₂"
    from D have D2: "𝒟 e⇩₂ ⌊dom(l(V↦v'))⌋" by (auto simp:hyperset_defs)
    from envconf type have "P ⊢ E(V ↦ T) √" by(auto simp:envconf_def)
    from IH2[OF hconf this D2 not_fin2]
    obtain h' l' e' where red2: "P,E(V ↦ T) ⊢ ⟨e⇩₂,(h, l(V↦v'))⟩ → ⟨e',(h', l')⟩"
      by auto
    from red_lcl_incr[OF red2] have "V ∈ dom l'" by auto
    with red2 casts show ?thesis by(fastforce intro:InitBlockRed)
  qed
next
  case (WTrtBlock E V T h e T')
  have IH: "⋀l. ⟦P ⊢ h √; P ⊢ E(V ↦ T) √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
                 ⟹ ∃e' s'. P,E(V ↦ T) ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
   and unass: "¬ assigned V e" and type:"is_type P T"
   and hconf: "P ⊢ h √" and envconf:"P ⊢ E √" 
    and D: "𝒟 {V:T; e} ⌊dom l⌋" by fact+
  show ?case
  proof cases
    assume "final e"
    thus ?thesis
    proof (rule finalE)
      fix v assume "e = Val v" with type show ?thesis by(fast intro:RedBlock)
    next
      fix r assume "e = Throw r"
      with type show ?thesis by(fast intro:red_reds.BlockThrow)
    qed
  next
    assume not_fin: "¬ final e"
    from D have De: "𝒟 e ⌊dom(l(V:=None))⌋" by(simp add:hyperset_defs)
    from envconf type have "P ⊢ E(V ↦ T) √" by(auto simp:envconf_def)
    from IH[OF hconf this De not_fin]
    obtain h' l' e' where red: "P,E(V ↦ T) ⊢ ⟨e,(h,l(V:=None))⟩ → ⟨e',(h',l')⟩"
      by auto
    show ?thesis
    proof (cases "l' V")
      assume "l' V = None"
      with red unass show ?thesis by(blast intro: BlockRedNone)
    next
      fix v assume "l' V = Some v"
      with red unass type show ?thesis by(blast intro: BlockRedSome)
    qed
  qed
next
  case (WTrtSeq E h e⇩₁ T⇩₁ e⇩₂ T⇩₂)
  show ?case
  proof cases
    assume "final e⇩₁"
    thus ?thesis
      by(fast elim:finalE intro:intro:RedSeq red_reds.SeqThrow)
  next
    assume "¬ final e⇩₁" with WTrtSeq show ?thesis
      by simp (blast intro:SeqRed)
  qed
next
  case (WTrtCond E h e e⇩₁ T e⇩₂)
  have wt: "P,E,h ⊢ e : Boolean" by fact
  show ?case
  proof cases
    assume "final e"
    thus ?thesis
    proof (rule finalE)
      fix v assume val: "e = Val v"
      then obtain b where v: "v = Bool b" using wt by (fastforce dest:typeof_Boolean)
      show ?thesis
      proof (cases b)
        case True with val v show ?thesis by(auto intro:RedCondT)
      next
        case False with val v show ?thesis by(auto intro:RedCondF)
      qed
    next
      fix r assume "e = Throw r"
      thus ?thesis by(fast intro:red_reds.CondThrow)
    qed
  next
    assume "¬ final e" with WTrtCond show ?thesis
      by simp (fast intro:CondRed)
  qed
next
  case WTrtWhile show ?case by(fast intro:RedWhile)
next
  case (WTrtThrow E h e T' T)
  show ?case
  proof cases
    assume "final e" ― ‹Then @{term e} must be @{term throw} or @{term null}›
    with WTrtThrow show ?thesis
      by(fastforce simp:final_def is_refT_def
                  intro:red_reds.ThrowThrow red_reds.RedThrowNull
                  dest!:typeof_NT typeof_Class_Subo)
  next
    assume "¬ final e" ― ‹Then @{term e} must reduce›
    with WTrtThrow show ?thesis by simp (blast intro:ThrowRed)
  qed
next
  case WTrtNil thus ?case by simp
next
  case (WTrtCons E h e T es Ts)
  have IHe: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟 e ⌊dom l⌋; ¬ final e⟧
                ⟹ ∃e' s'. P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',s'⟩"
   and IHes: "⋀l. ⟦P ⊢ h √; P ⊢ E √; 𝒟s es ⌊dom l⌋; ¬ finals es⟧
             ⟹ ∃es' s'. P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',s'⟩"
   and hconf: "P ⊢ h √" and envconf:"P ⊢ E √"
    and D: "𝒟s (e#es) ⌊dom l⌋"
   and not_fins: "¬ finals(e # es)" by fact+
  have De: "𝒟 e ⌊dom l⌋" and Des: "𝒟s es (⌊dom l⌋ ⊔ 𝒜 e)"
    using D by auto
  show ?case
  proof cases
    assume "final e"
    thus ?thesis
    proof (rule finalE)
      fix v assume e: "e = Val v"
      hence Des': "𝒟s es ⌊dom l⌋" using De Des by auto
      have not_fins_tl: "¬ finals es" using not_fins e by simp
      show ?thesis using e IHes[OF hconf envconf Des' not_fins_tl]
        by (blast intro!:ListRed2)
    next
      fix r assume "e = Throw r"
      hence False using not_fins by simp
      thus ?thesis ..
    qed
  next
    assume "¬ final e"
    from IHe[OF hconf envconf De this] show ?thesis by(fast intro!:ListRed1)
  qed
qed


end

Theory TypeSafe

(*  Title:       CoreC++
    Author:      Daniel Wasserrab
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>

    Based on the Jinja theory J/TypeSafe.thy by Tobias Nipkow 
*)

section ‹Type Safety Proof›

theory TypeSafe
imports HeapExtension CWellForm
begin


subsection‹Basic preservation lemmas›

lemma assumes wf:"wwf_prog P" and casts:"P ⊢ T casts v to v'"
  and typeof:"P ⊢ typeof⇘_h⇙ v = Some T'" and leq:"P ⊢ T' ≤ T"
  shows casts_conf:"P,h ⊢ v' :≤ T"

proof -
  { fix a' C Cs S'
    assume leq:"P ⊢ Class (last Cs) ≤ T" and subo:"Subobjs P C Cs"
      and casts':"P ⊢ T casts Ref (a',Cs) to v'" and h:"h a' = Some(C,S')"
    from subo wf have "is_class P (last Cs)" by(fastforce intro:Subobj_last_isClass)
    with leq wf obtain C' where T:"T = Class C'"
      and path_unique:"P ⊢ Path (last Cs) to C' unique"
      by(auto dest:Class_widen)
    from path_unique obtain Cs' where path_via:"P ⊢ Path (last Cs) to C' via Cs'"
      by(auto simp:path_via_def path_unique_def)
    with T path_unique casts' have v':"v' = Ref (a',Cs@⇩_pCs')"
      by -(erule casts_to.cases,auto simp:path_unique_def path_via_def)
    from subo path_via wf have "Subobjs P C (Cs@⇩_pCs')"
      and "last (Cs@⇩_pCs') = C'"
      apply(auto intro:Subobjs_appendPath simp:path_via_def)
      apply(drule_tac Cs="Cs'" in Subobjs_nonempty)
      by(rule sym[OF appendPath_last])
    with T h v' have ?thesis by auto }
  with casts typeof wf typeof leq show ?thesis
    by(cases v,auto elim:casts_to.cases split:if_split_asm)
qed



theorem assumes wf:"wwf_prog P"
shows red_preserves_hconf:
  "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ (⋀T. ⟦ P,E,h ⊢ e : T; P ⊢ h √ ⟧ ⟹ P ⊢ h' √)"
and reds_preserves_hconf:
  "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ (⋀Ts. ⟦ P,E,h ⊢ es [:] Ts; P ⊢ h √ ⟧ ⟹ P ⊢ h' √)"

proof (induct rule:red_reds_inducts)
  case (RedNew h a h' C E l)
  have new: "new_Addr h = Some a" and h':"h' = h(a ↦ (C, Collect (init_obj P C)))"
    and hconf:"P ⊢ h √" and wt_New:"P,E,h ⊢ new C : T" by fact+
  from new have None: "h a = None" by(rule new_Addr_SomeD)
  with wf have oconf:"P,h ⊢ (C, Collect (init_obj P C)) √"
    apply (auto simp:oconf_def)
    apply (rule_tac x="init_class_fieldmap P (last Cs)" in exI)
    by (fastforce intro:init_obj.intros fconf_init_fields 
                 elim: init_obj.cases dest!:Subobj_last_isClass simp:is_class_def)+
  thus ?case using h' None by(fast intro: hconf_new[OF hconf])
next
  case (RedFAss h a D S Cs' F T Cs v v' Ds fs' E l T')
  let ?fs' = "fs'(F ↦ v')"
  let ?S' = "insert (Ds, ?fs') (S - {(Ds, fs')})"
  have ha:"h a = Some(D,S)" and hconf:"P ⊢ h √"
    and field:"P ⊢ last Cs' has least F:T via Cs"
    and casts:"P ⊢ T casts v to v'"
    and Ds:"Ds = Cs' @⇩_p Cs" and S:"(Ds,fs') ∈ S"
    and wte:"P,E,h ⊢ ref(a,Cs')∙F{Cs} := Val v : T'" by fact+
  from wte have "P ⊢ last Cs' has least F:T' via Cs" by (auto split:if_split_asm)
  with field have eq:"T = T'" by (rule sees_field_fun)
  with casts wte wf have conf:"P,h ⊢ v' :≤ T'"
    by(auto intro:casts_conf)
  from hconf ha have oconf:"P,h ⊢ (D,S) √" by (fastforce simp:hconf_def)
  with S have suboD:"Subobjs P D Ds" by (fastforce simp:oconf_def)
  from field obtain Bs fs ms
    where subo:"Subobjs P (last Cs') Cs"
    and "class": "class P (last Cs) = Some(Bs,fs,ms)"
    and map:"map_of fs F = Some T"
    by (auto simp:LeastFieldDecl_def FieldDecls_def)
  from Ds subo have last:"last Cs = last Ds"
    by(fastforce dest:Subobjs_nonempty intro:appendPath_last simp:appendPath_last)
  with "class" have classDs:"class P (last Ds) = Some(Bs,fs,ms)" by simp
  with S suboD oconf have "P,h ⊢ fs' (:≤) map_of fs"
    apply (auto simp:oconf_def)
    apply (erule allE)
    apply (erule_tac x="Ds" in allE)
    apply (erule_tac x="fs'" in allE)
    apply clarsimp
    done
  with map conf eq have fconf:"P,h ⊢ fs'(F ↦ v') (:≤) map_of fs"
    by (simp add:fconf_def)
  from oconf have "∀Cs fs'. (Cs,fs') ∈ S ⟶ Subobjs P D Cs ∧ 
                    (∃fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) ∧ 
                                P,h ⊢ fs' (:≤) map_of fs)"
    by(simp add:oconf_def)
  with suboD classDs fconf 
  have oconf':"∀Cs fs'. (Cs,fs') ∈ ?S' ⟶ Subobjs P D Cs ∧ 
                    (∃fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) ∧ 
                                P,h ⊢ fs' (:≤) map_of fs)"
    by auto
  from oconf have all:"∀Cs. Subobjs P D Cs ⟶ (∃!fs'. (Cs,fs') ∈ S)"
    by(simp add:oconf_def)
  with S have "∀Cs. Subobjs P D Cs ⟶ (∃!fs'. (Cs,fs') ∈ ?S')" by blast
  with oconf' have oconf':"P,h ⊢ (D,?S') √"
    by (simp add:oconf_def)
  with hconf ha show ?case by (rule hconf_upd_obj)
next
  case (CallObj E e h l e' h' l' Copt M es) thus ?case by (cases Copt) auto
next
  case (CallParams E es h l es' h' l' v Copt M) thus ?case by (cases Copt) auto
next
  case (RedCallNull E Copt M vs h l) thus ?case by (cases Copt) auto
qed auto




theorem assumes wf:"wwf_prog P"
shows red_preserves_lconf:
  "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
  (⋀T. ⟦ P,E,h ⊢ e:T; P,h ⊢ l (:≤)⇩_w E; P ⊢ E √ ⟧ ⟹ P,h' ⊢ l' (:≤)⇩_w E)"
and reds_preserves_lconf:
  "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
  (⋀Ts. ⟦ P,E,h ⊢ es[:]Ts; P,h ⊢ l (:≤)⇩_w E; P ⊢ E √ ⟧ ⟹ P,h' ⊢ l' (:≤)⇩_w E)"

proof(induct rule:red_reds_inducts)
  case RedNew thus ?case
    by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedNew])
next
  case (RedLAss E V T v v' h l T')
  have casts:"P ⊢ T casts v to v'" and env:"E V = Some T"
    and wt:"P,E,h ⊢ V:=Val v : T'" and lconf:"P,h ⊢ l (:≤)⇩_w E" by fact+
  from wt env have eq:"T = T'" by auto
  with casts wt wf have conf:"P,h ⊢ v' :≤ T'"
    by(auto intro:casts_conf)
  with lconf env eq show ?case
    by (simp del:fun_upd_apply)(erule lconf_upd,simp_all)
next
  case RedFAss thus ?case
    by(auto intro:lconf_hext red_hext_incr[OF red_reds.RedFAss] 
         simp del:fun_upd_apply)
next
  case (BlockRedNone E V T e h l e' h' l' T')
  have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e',(h', l')⟩"
    and IH: "⋀T''. ⟦ P,E(V ↦ T),h ⊢ e : T''; P,h ⊢ l(V:=None) (:≤)⇩_w E(V ↦ T);
                      envconf P (E(V ↦ T)) ⟧
                   ⟹ P,h' ⊢ l' (:≤)⇩_w E(V ↦ T)"
    and lconf: "P,h ⊢ l (:≤)⇩_w E" and wte: "P,E,h ⊢ {V:T; e} : T'"
    and envconf:"envconf P E" by fact+
  from lconf_hext[OF lconf red_hext_incr[OF red]]
  have lconf':"P,h' ⊢ l (:≤)⇩_w E" .
  from wte have wte':"P,E(V↦T),h ⊢ e : T'" and type:"is_type P T"
    by (auto elim:WTrt.cases)
  from envconf type have envconf':"envconf P (E(V ↦ T))"
    by(auto simp:envconf_def)
  from lconf have "P,h ⊢ (l(V := None)) (:≤)⇩_w E(V↦T)"
    by (simp add:lconf_def fun_upd_apply)
  from IH[OF wte' this envconf'] have "P,h' ⊢ l' (:≤)⇩_w E(V↦T)" .
  with lconf' show ?case
    by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
next
  case (BlockRedSome E V T e h l e' h' l' v T')
  have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e',(h', l')⟩"
    and IH: "⋀T''. ⟦ P,E(V ↦ T),h ⊢ e : T''; P,h ⊢ l(V:=None) (:≤)⇩_w E(V ↦ T);
                      envconf P (E(V ↦ T)) ⟧
                   ⟹ P,h' ⊢ l' (:≤)⇩_w E(V ↦ T)"
    and lconf: "P,h ⊢ l (:≤)⇩_w E" and wte: "P,E,h ⊢ {V:T; e} : T'"
    and envconf:"envconf P E" by fact+
  from lconf_hext[OF lconf red_hext_incr[OF red]]
  have lconf':"P,h' ⊢ l (:≤)⇩_w E" .
  from wte have wte':"P,E(V↦T),h ⊢ e : T'" and type:"is_type P T"
    by (auto elim:WTrt.cases)
  from envconf type have envconf':"envconf P (E(V ↦ T))"
    by(auto simp:envconf_def)
  from lconf have "P,h ⊢ (l(V := None)) (:≤)⇩_w E(V↦T)"
    by (simp add:lconf_def fun_upd_apply)
  from IH[OF wte' this envconf'] have "P,h' ⊢ l' (:≤)⇩_w E(V↦T)" .
  with lconf' show ?case
    by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
next
  case (InitBlockRed E V T e h l v' e' h' l' v'' v T')
  have red: "P,E(V ↦ T) ⊢ ⟨e, (h, l(V↦v'))⟩ → ⟨e',(h', l')⟩"
     and IH: "⋀T''. ⟦ P,E(V ↦ T),h ⊢ e : T''; P,h ⊢ l(V ↦ v') (:≤)⇩_w E(V ↦ T); 
                       envconf P (E(V ↦ T)) ⟧
                   ⟹ P,h' ⊢ l' (:≤)⇩_w E(V ↦ T)"
    and lconf:"P,h ⊢ l (:≤)⇩_w E" and l':"l' V = Some v''"
    and wte:"P,E,h ⊢ {V:T; V:=Val v;; e} : T'"
    and casts:"P ⊢ T casts v to v'" and envconf:"envconf P E" by fact+
  from lconf_hext[OF lconf red_hext_incr[OF red]]
  have lconf':"P,h' ⊢ l (:≤)⇩_w E" .
  from wte obtain T'' where wte':"P,E(V↦T),h ⊢ e : T'"
    and wt:"P,E(V ↦ T),h ⊢ V:=Val v : T''"
    and type:"is_type P T"
    by (auto elim:WTrt.cases)
  from envconf type have envconf':"envconf P (E(V ↦ T))"
    by(auto simp:envconf_def)
  from wt have "T'' = T" by auto
  with wf casts wt have "P,h ⊢ v' :≤ T"
    by(auto intro:casts_conf)
  with lconf have "P,h ⊢ l(V ↦ v') (:≤)⇩_w E(V↦T)"
    by -(rule lconf_upd2)
  from IH[OF wte' this envconf'] have "P,h' ⊢ l' (:≤)⇩_w E(V ↦ T)" .
  with lconf' show ?case
    by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
next
  case (CallObj E e h l e' h' l' Copt M es) thus ?case by (cases Copt) auto
next
  case (CallParams E es h l es' h' l' v Copt M) thus ?case by (cases Copt) auto
next
  case (RedCallNull E Copt M vs h l) thus ?case by (cases Copt) auto
qed auto




text‹Preservation of definite assignment more complex and requires a
few lemmas first.›

lemma [iff]: "⋀A. ⟦ length Vs = length Ts; length vs = length Ts⟧ ⟹
 𝒟 (blocks (Vs,Ts,vs,e)) A = 𝒟 e (A ⊔ ⌊set Vs⌋)"

apply(induct Vs Ts vs e rule:blocks_old_induct)
apply(simp_all add:hyperset_defs)
done


lemma red_lA_incr: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ ⌊dom l⌋ ⊔ 𝒜 e ⊑  ⌊dom l'⌋ ⊔ 𝒜 e'"
  and reds_lA_incr: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ ⌊dom l⌋ ⊔ 𝒜s es ⊑  ⌊dom l'⌋ ⊔ 𝒜s es'"
  apply (induct rule:red_reds_inducts)
  apply (simp_all del: fun_upd_apply add: hyperset_defs)
  apply blast
  apply blast
  apply blast
  apply blast
  apply blast
  apply blast
  apply blast
  apply auto
  done



text‹Now preservation of definite assignment.›

lemma assumes wf: "wf_C_prog P"
shows red_preserves_defass:
  "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹ 𝒟 e ⌊dom l⌋ ⟹ 𝒟 e' ⌊dom l'⌋"
and "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹ 𝒟s es ⌊dom l⌋ ⟹ 𝒟s es' ⌊dom l'⌋"

proof (induct rule:red_reds_inducts)
  case BinOpRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case FAssRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case CallObj thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
next
  case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs'
                vs bs new_body E)
  thus ?case
    apply (auto dest!:select_method_wf_mdecl[OF wf] simp:wf_mdecl_def elim!:D_mono')
    apply(cases T') apply auto
    by(rule_tac A="⌊insert this (set pns)⌋" in D_mono,clarsimp simp:hyperset_defs,
          assumption)+
next
  case RedStaticCall thus ?case
    apply (auto dest!:has_least_wf_mdecl[OF wf] simp:wf_mdecl_def elim!:D_mono')
    by(auto simp:hyperset_defs)
next
  case InitBlockRed thus ?case
    by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
  case BlockRedNone thus ?case
    by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
  case BlockRedSome thus ?case
    by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
next
  case SeqRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case CondRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
next
  case RedWhile thus ?case by(auto simp:hyperset_defs elim!:D_mono')
next
  case ListRed1 thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
qed (auto simp:hyperset_defs)




text‹Combining conformance of heap and local variables:›

definition sconf :: "prog ⇒ env ⇒ state ⇒ bool"  ("_,_ ⊢ _ √"   [51,51,51]50) where
  "P,E ⊢ s √  ≡  let (h,l) = s in P ⊢ h √ ∧ P,h ⊢ l (:≤)⇩_w E ∧ P ⊢ E √"

lemma red_preserves_sconf:
  "⟦ P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩; P,E,hp s ⊢ e : T; P,E ⊢ s √; wwf_prog P⟧ 
⟹ P,E ⊢ s' √"

by(fastforce intro:red_preserves_hconf red_preserves_lconf
            simp add:sconf_def)


lemma reds_preserves_sconf:
  "⟦ P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩; P,E,hp s ⊢ es [:] Ts; P,E ⊢ s √; wwf_prog P⟧ 
⟹ P,E ⊢ s' √"

by(fastforce intro:reds_preserves_hconf reds_preserves_lconf
            simp add:sconf_def)





subsection "Subject reduction"

lemma wt_blocks:
 "⋀E. ⟦ length Vs = length Ts; length vs = length Ts;
         ∀T' ∈ set Ts. is_type P T'⟧ ⟹
       (P,E,h ⊢ blocks(Vs,Ts,vs,e) : T) =
  (P,E(Vs[↦]Ts),h ⊢ e:T ∧ 
  (∃Ts'. map (P ⊢ typeof⇘_h⇙) vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))"

proof(induct Vs Ts vs e rule:blocks_old_induct)
  case (5 V Vs T' Ts v vs e)
  have length:"length (V#Vs) = length (T'#Ts)" "length (v#vs) = length (T'#Ts)"
    and type:"∀S ∈ set (T'#Ts). is_type P S"
    and IH:"⋀E. ⟦length Vs = length Ts; length vs = length Ts;
                  ∀S ∈ set Ts. is_type P S⟧
     ⟹ (P,E,h ⊢ blocks (Vs, Ts, vs, e) : T) =
         (P,E(Vs [↦] Ts),h ⊢ e : T ∧
            (∃Ts'. map P ⊢ typeof⇘_h⇙ vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))" by fact+
  from type have typeT':"is_type P T'" and type':"∀S ∈ set Ts. is_type P S"
    by simp_all
  from length have "length Vs = length Ts" "length vs = length Ts"
    by simp_all
  from IH[OF this type'] have eq:"(P,E(V ↦ T'),h ⊢ blocks (Vs,Ts,vs,e) : T) =
  (P,E(V ↦ T')(Vs [↦] Ts),h ⊢ e : T ∧
   (∃Ts'. map P ⊢ typeof⇘_h⇙ vs = map Some Ts' ∧ P ⊢ Ts' [≤] Ts))" .
  show ?case
  proof(rule iffI)
    assume "P,E,h ⊢ blocks (V#Vs,T'#Ts,v#vs,e) : T"
    then have wt:"P,E(V ↦ T'),h ⊢ V:=Val v : T'"
      and blocks:"P,E(V ↦ T'),h ⊢ blocks (Vs,Ts,vs,e) : T" by auto
    from blocks eq obtain Ts' where wte:"P,E(V ↦ T')(Vs [↦] Ts),h ⊢ e : T"
      and typeof:"map P ⊢ typeof⇘_h⇙ vs = map Some Ts'" and subs:"P ⊢ Ts' [≤] Ts"
      by auto
    from wt obtain T'' where "P ⊢ typeof⇘_h⇙ v = Some T''" and "P ⊢ T'' ≤ T'"
      by auto
    with wte typeof subs
    show "P,E(V # Vs [↦] T' # Ts),h ⊢ e : T ∧
          (∃Ts'. map P ⊢ typeof⇘_h⇙ (v # vs) = map Some Ts' ∧ P ⊢ Ts' [≤] (T' # Ts))"
      by auto
  next
    assume "P,E(V # Vs [↦] T' # Ts),h ⊢ e : T ∧
      (∃Ts'. map P ⊢ typeof⇘_h⇙ (v # vs) = map Some Ts' ∧ P ⊢ Ts' [≤] (T' # Ts))"
    then obtain Ts' where wte:"P,E(V # Vs [↦] T' # Ts),h ⊢ e : T"
      and typeof:"map P ⊢ typeof⇘_h⇙ (v # vs) = map Some Ts'"
      and subs:"P ⊢ Ts' [≤] (T'#Ts)" by auto
    from subs obtain U Us where Ts':"Ts' = U#Us" by(cases Ts') auto
    with wte typeof subs eq have blocks:"P,E(V ↦ T'),h ⊢ blocks (Vs,Ts,vs,e) : T"
      by auto
    from Ts' typeof subs have "P ⊢ typeof⇘_h⇙ v = Some U"
      and "P ⊢ U ≤ T'" by (auto simp:fun_of_def)
    hence wtval:"P,E(V ↦ T'),h ⊢ V:=Val v : T'" by auto
    with blocks typeT' show "P,E,h ⊢ blocks (V#Vs,T'#Ts,v#vs,e) : T" by auto
  qed
qed auto




theorem assumes wf: "wf_C_prog P"
shows subject_reduction2: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩ ⟹
  (⋀T. ⟦ P,E ⊢ (h,l) √; P,E,h ⊢ e : T ⟧ ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T)"
and subjects_reduction2: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩ ⟹
  (⋀Ts.⟦ P,E ⊢ (h,l) √; P,E,h ⊢ es [:] Ts ⟧ ⟹ types_conf P E h' es' Ts)"

proof (induct rule:red_reds_inducts)
  case (RedNew h a h' C E l)
  have new:"new_Addr h = Some a" and h':"h' = h(a ↦ (C, Collect (init_obj P C)))" 
    and wt:"P,E,h ⊢ new C : T" by fact+
  from wt have eq:"T = Class C" and "class": "is_class P C" by auto
  from "class" have subo:"Subobjs P C [C]" by(rule Subobjs_Base)
  from h' have "h' a = Some(C, Collect (init_obj P C))" by(simp add:map_upd_Some_unfold)
  with subo have "P,E,h' ⊢ ref(a,[C]) : Class C" by auto
  with eq show ?case by auto
next
  case (RedNewFail h E C l)
  have sconf:"P,E ⊢ (h, l) √" by fact
  from wf have "is_class P OutOfMemory" 
    by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
  hence "preallocated h ⟹ P ⊢ typeof⇘_h⇙ (Ref (addr_of_sys_xcpt OutOfMemory,[OutOfMemory])) = Some(Class OutOfMemory)"
    by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
  with sconf have "P,E,h ⊢ THROW OutOfMemory : T" by(auto simp:sconf_def hconf_def)
  thus ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (StaticCastRed E e h l e' h' l' C)
  have wt:"P,E,h ⊢ ⦇C⦈e : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h, l) √" by fact+
  from wt obtain T' where wte:"P,E,h ⊢ e : T'" and isref:"is_refT T'" 
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from isref have "P,E,h' ⊢ ⦇C⦈e' : Class C"
  proof(rule refTE)
    assume "T' = NT"
    with IH[OF sconf wte] isref "class" show ?thesis by auto
  next
    fix D assume "T' = Class D"
    with IH[OF sconf wte] isref "class" show ?thesis by auto
  qed
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case RedStaticCastNull
  thus ?case by (auto elim:WTrt.cases)
next
  case (RedStaticUpCast Cs C Cs' Ds E a h l)
  have wt:"P,E,h ⊢ ⦇C⦈ref (a,Cs) : T"
    and path_via:"P ⊢ Path last Cs to C via Cs'"
    and Ds:"Ds = Cs @⇩_p Cs'" by fact+
  from wt have typeof:"P ⊢ typeof⇘_h⇙ (Ref(a,Cs)) = Some(Class(last Cs))"
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from typeof obtain D S where h:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
    by (auto dest:typeof_Class_Subo split:if_split_asm)
  from path_via subo wf Ds have "Subobjs P D Ds" and last:"last Ds = C"
    by(auto intro!:Subobjs_appendPath appendPath_last[THEN sym] Subobjs_nonempty
            simp:path_via_def)
  with h have "P,E,h ⊢ ref (a,Ds) : Class C" by auto
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (RedStaticDownCast E C a Cs Cs' h l)
  have "P,E,h ⊢ ⦇C⦈ref (a,Cs@[C]@Cs') : T" by fact
  hence typeof:"P ⊢ typeof⇘_h⇙ (Ref(a,Cs@[C]@Cs')) = Some(Class(last(Cs@[C]@Cs')))"
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from typeof obtain D S where h:"h a = Some(D,S)" 
    and subo:"Subobjs P D (Cs@[C]@Cs')"
    by (auto dest:typeof_Class_Subo split:if_split_asm)
  from subo have "Subobjs P D (Cs@[C])" by(fastforce intro:appendSubobj)
  with h have "P,E,h ⊢ ref (a,Cs@[C]) : Class C" by auto
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (RedStaticCastFail C Cs E a h l)
  have sconf:"P,E ⊢ (h, l) √" by fact
  from wf have "is_class P ClassCast" 
    by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
  hence "preallocated h ⟹ P ⊢ typeof⇘_h⇙ (Ref (addr_of_sys_xcpt ClassCast,[ClassCast])) = Some(Class ClassCast)"
    by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
  with sconf have "P,E,h ⊢ THROW ClassCast : T" by(auto simp:sconf_def hconf_def)
  thus ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (DynCastRed E e h l e' h' l' C)
  have wt:"P,E,h ⊢ Cast C e : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt obtain T' where wte:"P,E,h ⊢ e : T'" and isref:"is_refT T'" 
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from isref have "P,E,h' ⊢ Cast C e' : Class C"
  proof(rule refTE)
    assume "T' = NT"
    with IH[OF sconf wte] isref "class" show ?thesis by auto
  next
    fix D assume "T' = Class D"
    with IH[OF sconf wte] isref "class" show ?thesis by auto
  qed
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case RedDynCastNull
  thus ?case by (auto elim:WTrt.cases)
next
  case (RedDynCast h l a D S C Cs' E Cs)
  have wt:"P,E,h ⊢ Cast C (ref (a,Cs)) : T"
    and path_via:"P ⊢ Path D to C via Cs'"
    and hp:"hp (h,l) a = Some(D,S)" by fact+
  from wt have typeof:"P ⊢ typeof⇘_h⇙ (Ref(a,Cs)) = Some(Class(last Cs))"
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from typeof hp have subo:"Subobjs P D Cs"
    by (auto dest:typeof_Class_Subo split:if_split_asm)
  from path_via subo have "Subobjs P D Cs'" 
    and last:"last Cs' = C" by (auto simp:path_via_def)
  with hp have "P,E,h ⊢ ref (a,Cs') : Class C" by auto
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (RedStaticUpDynCast Cs C Cs' Ds E a h l)
  have wt:"P,E,h ⊢ Cast C (ref (a,Cs)) : T"
    and path_via:"P ⊢ Path last Cs to C via Cs'"
    and Ds:"Ds = Cs @⇩_p Cs'" by fact+
  from wt have typeof:"P ⊢ typeof⇘_h⇙ (Ref(a,Cs)) = Some(Class(last Cs))"
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from typeof obtain D S where h:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
    by (auto dest:typeof_Class_Subo split:if_split_asm)
  from path_via subo wf Ds have "Subobjs P D Ds" and last:"last Ds = C"
    by(auto intro!:Subobjs_appendPath appendPath_last[THEN sym] Subobjs_nonempty
            simp:path_via_def)
  with h have "P,E,h ⊢ ref (a,Ds) : Class C" by auto
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (RedStaticDownDynCast E C a Cs Cs' h l)
  have "P,E,h ⊢ Cast C (ref (a,Cs@[C]@Cs')) : T" by fact
  hence typeof:"P ⊢ typeof⇘_h⇙ (Ref(a,Cs@[C]@Cs')) = Some(Class(last(Cs@[C]@Cs')))"
    and "class": "is_class P C" and T:"T = Class C"
    by auto
  from typeof obtain D S where h:"h a = Some(D,S)" 
    and subo:"Subobjs P D (Cs@[C]@Cs')"
    by (auto dest:typeof_Class_Subo split:if_split_asm)
  from subo have "Subobjs P D (Cs@[C])" by(fastforce intro:appendSubobj)
  with h have "P,E,h ⊢ ref (a,Cs@[C]) : Class C" by auto
  with T show ?case by (fastforce intro:wt_same_type_typeconf)
next
  case RedDynCastFail thus ?case by fastforce
next
  case (BinOpRed1 E e h l e' h' l' bop e⇩₂)
  have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
    and wt:"P,E,h ⊢ e «bop» e⇩₂ : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt obtain T⇩₁ T⇩₂ where wte:"P,E,h ⊢ e : T⇩₁" and wte2:"P,E,h ⊢ e⇩₂ : T⇩₂"
    and binop:"case bop of Eq ⇒ T = Boolean
                        | Add ⇒ T⇩₁ = Integer ∧ T⇩₂ = Integer ∧ T = Integer"
    by auto
  from WTrt_hext_mono[OF wte2 red_hext_incr[OF red]] have wte2':"P,E,h' ⊢ e⇩₂ : T⇩₂" .
  have "P,E,h' ⊢ e' «bop» e⇩₂ : T"
  proof (cases bop)
    assume Eq:"bop = Eq"
    from IH[OF sconf wte] obtain T' where "P,E,h' ⊢ e' : T'"
      by (cases "T⇩₁") auto
    with wte2' binop Eq show ?thesis by(cases bop) auto
  next
    assume Add:"bop = Add"
    with binop have Intg:"T⇩₁ = Integer" by simp
    with IH[OF sconf wte] have "P,E,h' ⊢ e' : Integer" by simp
    with wte2' binop Add show ?thesis by(cases bop) auto
  qed
  with binop show ?case by(cases bop) simp_all
next
  case (BinOpRed2 E e h l e' h' l' v⇩₁ bop)
  have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
    and wt:"P,E,h ⊢ Val v⇩₁ «bop» e : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt obtain T⇩₁ T⇩₂ where wtval:"P,E,h ⊢ Val v⇩₁ : T⇩₁" and wte:"P,E,h ⊢ e : T⇩₂"
    and binop:"case bop of Eq ⇒ T = Boolean
                        | Add ⇒ T⇩₁ = Integer ∧ T⇩₂ = Integer ∧ T = Integer"
    by auto
  from WTrt_hext_mono[OF wtval red_hext_incr[OF red]]
  have wtval':"P,E,h' ⊢ Val v⇩₁ : T⇩₁" .
  have "P,E,h' ⊢ Val v⇩₁ «bop» e' : T"
  proof (cases bop)
    assume Eq:"bop = Eq"
    from IH[OF sconf wte] obtain T' where "P,E,h' ⊢ e' : T'"
      by (cases "T⇩₂") auto
    with wtval' binop Eq show ?thesis by(cases bop) auto
  next
    assume Add:"bop = Add"
    with binop have Intg:"T⇩₂ = Integer" by simp
    with IH[OF sconf wte] have "P,E,h' ⊢ e' : Integer" by simp
    with wtval' binop Add show ?thesis by(cases bop) auto
  qed
  with binop show ?case by(cases bop) simp_all
next
  case (RedBinOp bop v⇩₁ v⇩₂ v E a b) thus ?case
  proof (cases bop)
    case Eq thus ?thesis using RedBinOp by auto
  next
    case Add thus ?thesis using RedBinOp by auto
  qed
next
  case (RedVar h l V v E)
  have l:"lcl (h, l) V = Some v" and sconf:"P,E ⊢ (h, l) √"
    and wt:"P,E,h ⊢ Var V : T" by fact+
  hence conf:"P,h ⊢ v :≤ T" by(force simp:sconf_def lconf_def)
  show ?case
  proof(cases "∀C. T ≠ Class C")
    case True 
    with conf have "P ⊢ typeof⇘_h⇙ v = Some T" by(cases T) auto
    hence "P,E,h ⊢ Val v : T" by auto
    thus ?thesis by(rule wt_same_type_typeconf)
  next
    case False
    then obtain C where T:"T = Class C" by auto
    with conf have "P ⊢ typeof⇘_h⇙ v = Some(Class C) ∨ P ⊢ typeof⇘_h⇙ v = Some NT"
      by simp
    with T show ?thesis by simp
  qed
next
  case (LAssRed E e h l e' h' l' V)
  have wt:"P,E,h ⊢ V:=e : T" and sconf:"P,E ⊢ (h, l) √"
    and IH:"⋀T'. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T'⟧ ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'" by fact+
  from wt obtain T' where wte:"P,E,h ⊢ e : T'" and env:"E V = Some T" 
    and sub:"P ⊢ T' ≤ T" by auto
  from sconf env have "is_type P T" by(auto simp:sconf_def envconf_def)
  from sub this wf show ?case
  proof(rule subE)
    assume eq:"T' = T" and notclass:"∀C. T' ≠ Class C"
    with IH[OF sconf wte] have "P,E,h' ⊢ e' : T" by(cases T) auto
    with eq env have "P,E,h' ⊢ V:=e' : T" by auto
    with eq show ?thesis by(cases T) auto
  next
    fix C D
    assume T':"T' = Class C" and T:"T = Class D" 
      and path_unique:"P ⊢ Path C to D unique"
    with IH[OF sconf wte] have "P,E,h' ⊢ e' : Class C ∨ P,E,h' ⊢ e' : NT"
      by simp
    hence "P,E,h' ⊢ V:=e' : T"
    proof(rule disjE)
      assume "P,E,h' ⊢ e' : Class C"
      with env T' sub show ?thesis by (fastforce intro:WTrtLAss)
    next
      assume "P,E,h' ⊢ e' : NT"
      with env T show ?thesis by (fastforce intro:WTrtLAss)
    qed
    with T show ?thesis by(cases T) auto
  next
    fix C
    assume T':"T' = NT" and T:"T = Class C"
    with IH[OF sconf wte] have "P,E,h' ⊢ e' : NT" by simp
    with env T show ?thesis by (fastforce intro:WTrtLAss)
  qed
next
  case (RedLAss E V T v v' h l T')
  have env:"E V = Some T" and casts:"P ⊢ T casts v to v'"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ V:=Val v : T'" by fact+
  show ?case
  proof(cases "∀C. T ≠ Class C")
    case True
    with casts wt env show ?thesis
      by(cases T',auto elim!:casts_to.cases)
  next
    case False
    then obtain C where "T = Class C" by auto
    with casts wt env wf show ?thesis
      by(auto elim!:casts_to.cases,
         auto intro!:sym[OF appendPath_last] Subobjs_nonempty split:if_split_asm 
              simp:path_via_def,drule_tac Cs="Cs" in Subobjs_appendPath,auto)
  qed
next
  case (FAccRed E e h l e' h' l' F Cs)
  have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
    and wt:"P,E,h ⊢ e∙F{Cs} : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt have "P,E,h' ⊢ e'∙F{Cs} : T"
  proof(rule WTrt_elim_cases)
    fix C assume wte: "P,E,h ⊢ e : Class C"
      and field:"P ⊢ C has least F:T via Cs"
      and notemptyCs:"Cs ≠ []"
    from field have "class": "is_class P C"
      by (fastforce intro:Subobjs_isClass simp add:LeastFieldDecl_def FieldDecls_def)
    from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT ∨ P,E,h' ⊢ e' : Class C" by auto
    thus ?thesis
    proof(rule disjE)
      assume "P,E,h' ⊢ e' : NT"
      thus ?thesis by (fastforce intro!:WTrtFAccNT)
    next
      assume wte':"P,E,h' ⊢ e' : Class C"
      from wte' notemptyCs field show ?thesis by(rule WTrtFAcc)
    qed
  next
    assume wte: "P,E,h ⊢ e : NT"
    from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT" by auto
    thus ?thesis by (rule WTrtFAccNT)
  qed
  thus ?case by(rule wt_same_type_typeconf)
next
  case (RedFAcc h l a D S Ds Cs' Cs fs' F v E)
  have h:"hp (h,l) a = Some(D,S)" 
    and Ds:"Ds = Cs'@⇩_pCs" and S:"(Ds,fs') ∈ S"
    and fs':"fs' F = Some v" and sconf:"P,E ⊢ (h,l) √"
    and wte:"P,E,h ⊢ ref (a,Cs')∙F{Cs} : T" by fact+
  from wte have field:"P ⊢ last Cs' has least F:T via Cs"
    and notemptyCs:"Cs ≠ []"
    by (auto split:if_split_asm)
  from h S sconf obtain Bs fs ms where classDs:"class P (last Ds) = Some (Bs,fs,ms)"
    and fconf:"P,h ⊢ fs' (:≤) map_of fs"
    by (simp add:sconf_def hconf_def oconf_def) blast
  from field Ds have "last Cs = last Ds"
    by (fastforce intro!:appendPath_last Subobjs_nonempty 
                   simp:LeastFieldDecl_def FieldDecls_def)
  with field classDs have map:"map_of fs F =  Some T"
    by (simp add:LeastFieldDecl_def FieldDecls_def)
  with fconf fs' have conf:"P,h ⊢ v :≤ T"
    by (simp add:fconf_def,erule_tac x="F" in allE,fastforce)
  thus ?case by (cases T) auto
next
  case (RedFAccNull E F Cs h l)
  have sconf:"P,E ⊢ (h, l) √" by fact
  from wf have "is_class P NullPointer" 
    by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
  hence "preallocated h ⟹ P ⊢ typeof⇘_h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
    by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
  with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
  thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
next
  case (FAssRed1 E e h l e' h' l' F Cs e⇩₂)
  have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
    and wt:"P,E,h ⊢ e∙F{Cs} := e⇩₂ : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt have "P,E,h' ⊢ e'∙F{Cs} := e⇩₂ : T"
  proof (rule WTrt_elim_cases)
    fix C T' assume wte: "P,E,h ⊢ e : Class C"
      and field:"P ⊢ C has least F:T via Cs"
      and notemptyCs:"Cs ≠ []"
      and wte2:"P,E,h ⊢ e⇩₂ : T'" and sub:"P ⊢ T' ≤ T"
    have wte2': "P,E,h' ⊢ e⇩₂ : T'"
      by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
    from IH[OF sconf wte] have "P,E,h' ⊢ e' : Class C ∨ P,E,h' ⊢ e' : NT"
      by simp
    thus ?thesis
    proof(rule disjE)
      assume wte':"P,E,h' ⊢ e' : Class C"
      from wte' notemptyCs field wte2' sub show ?thesis by (rule WTrtFAss)
    next
      assume wte':"P,E,h' ⊢ e' : NT"
      from wte' wte2' sub show ?thesis by (rule WTrtFAssNT)
    qed
  next
    fix T' assume wte:"P,E,h ⊢ e : NT"
      and wte2:"P,E,h ⊢ e⇩₂ : T'" and sub:"P ⊢ T' ≤ T"
    have wte2': "P,E,h' ⊢ e⇩₂ : T'"
      by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
    from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : NT" by simp
    from wte' wte2' sub show ?thesis by (rule WTrtFAssNT)
  qed
  thus ?case by(rule wt_same_type_typeconf)
next
  case (FAssRed2 E e h l e' h' l' v F Cs)
  have red:"P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
    and wt:"P,E,h ⊢ Val v∙F{Cs} := e : T"
    and IH:"⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧ 
            ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt have "P,E,h' ⊢ Val v∙F{Cs}:=e' : T"
  proof (rule WTrt_elim_cases)
    fix C T' assume wtval:"P,E,h ⊢ Val v : Class C"
      and field:"P ⊢ C has least F:T via Cs"
      and notemptyCs:"Cs ≠ []"
      and wte:"P,E,h ⊢ e : T'"
      and sub:"P ⊢ T' ≤ T"
    have wtval':"P,E,h' ⊢ Val v : Class C"
      by(rule WTrt_hext_mono[OF wtval red_hext_incr[OF red]])
    from field wf have type:"is_type P T" by(rule least_field_is_type)
    from sub type wf show ?thesis
    proof(rule subE)
      assume "T' = T" and notclass:"∀C. T' ≠ Class C"
      from IH[OF sconf wte] notclass have wte':"P,E,h' ⊢ e' : T'" 
        by(cases T') auto
      from wtval' notemptyCs field wte' sub show ?thesis
        by(rule WTrtFAss)
    next
      fix C' D assume T':"T' = Class C'" and T:"T = Class D" 
        and path_unique:"P ⊢ Path C' to D unique"
      from IH[OF sconf wte] T' have "P,E,h' ⊢ e' : Class C' ∨ P,E,h' ⊢ e' : NT"
        by simp
      thus ?thesis
      proof(rule disjE)
        assume wte':"P,E,h' ⊢ e' : Class C'"
        from wtval' notemptyCs field wte' sub T' show ?thesis 
          by (fastforce intro: WTrtFAss)
      next
        assume wte':"P,E,h' ⊢ e' : NT"
        from wtval' notemptyCs field wte' sub T show ?thesis
          by (fastforce intro: WTrtFAss)
      qed
    next
      fix C' assume T':"T' = NT" and T:"T = Class C'"
      from IH[OF sconf wte] T' have wte':"P,E,h' ⊢ e' : NT" by simp
      from wtval' notemptyCs field wte' sub T show ?thesis
        by (fastforce intro: WTrtFAss)
    qed
  next
    fix T' assume wtval:"P,E,h ⊢ Val v : NT"
      and wte:"P,E,h ⊢ e : T'"
      and sub:"P ⊢ T' ≤ T"
    have wtval':"P,E,h' ⊢ Val v : NT"
      by(rule WTrt_hext_mono[OF wtval red_hext_incr[OF red]])
    from IH[OF sconf wte] sub obtain T'' where wte':"P,E,h' ⊢ e' : T''"
      and sub':"P ⊢ T'' ≤ T" by (cases T',auto,cases T,auto)
    from wtval' wte' sub' show ?thesis
      by(rule WTrtFAssNT)
  qed
  thus ?case by(rule wt_same_type_typeconf)
next
  case (RedFAss h a D S Cs' F T Cs v v' Ds fs E l T')
  let ?fs' = "fs(F ↦ v')"
  let ?S' = "insert (Ds, ?fs') (S - {(Ds, fs)})"
  let ?h' = "h(a ↦ (D,?S'))"
  have h:"h a = Some(D,S)" and casts:"P ⊢ T casts v to v'"
    and field:"P ⊢ last Cs' has least F:T via Cs"
    and wt:"P,E,h ⊢ ref (a,Cs')∙F{Cs} := Val v : T'" by fact+
  from wt wf have type:"is_type P T'" 
    by (auto dest:least_field_is_type split:if_split_asm)
  from wt field obtain T'' where wtval:"P,E,h ⊢ Val v : T''" and eq:"T = T'" 
    and leq:"P ⊢ T'' ≤ T'"
    by (auto dest:sees_field_fun split:if_split_asm)
  from casts eq wtval show ?case
  proof(induct rule:casts_to.induct)
    case (casts_prim T⇩₀ w)
    have "T⇩₀ = T'" and "∀C. T⇩₀ ≠ Class C" and wtval':"P,E,h ⊢ Val w : T''" by fact+
    with leq have "T' = T''" by(cases T',auto)
    with wtval' have "P,E,h ⊢ Val w : T'" by simp
    with h have "P,E,(h(a↦(D,insert(Ds,fs(F ↦ w))(S-{(Ds,fs)})))) ⊢ Val w : T'"
      by(cases w,auto split:if_split_asm)
    thus "P,E,(h(a↦(D,insert(Ds,fs(F ↦ w))(S-{(Ds,fs)})))) ⊢ (Val w) :⇘_NT⇙ T'"
      by(rule wt_same_type_typeconf)
  next
    case (casts_null C'')
    have T':"Class C'' = T'" by fact
    have "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Null))(S-{(Ds,fs)})))) ⊢ null : NT"
      by simp
    with sym[OF T']
    show "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Null))(S-{(Ds,fs)})))) ⊢ null :⇘_NT⇙ T'"
      by simp
  next
    case (casts_ref Xs C'' Xs' Ds'' a')
    have "Class C'' = T'" and "Ds'' = Xs @⇩_p Xs'"
      and "P ⊢ Path last Xs to C'' via Xs'"
      and "P,E,h ⊢ ref (a', Xs) : T''" by fact+
    with wf have "P,E,h ⊢ ref (a',Ds'') : T'"
      by (auto intro!:appendPath_last[THEN sym] Subobjs_nonempty
        split:if_split_asm simp:path_via_def,
        drule_tac Cs="Xs" in Subobjs_appendPath,auto)
    with h have "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Ref(a',Ds'')))(S-{(Ds,fs)})))) ⊢ 
      ref (a',Ds'') : T'"
      by auto
    thus "P,E,(h(a↦(D,insert(Ds,fs(F ↦ Ref(a',Ds'')))(S-{(Ds,fs)})))) ⊢ 
      ref (a',Ds'') :⇘_NT⇙ T'"
      by(rule wt_same_type_typeconf)
  qed
next
  case (RedFAssNull E F Cs v h l)
  have sconf:"P,E ⊢ (h, l) √" by fact
  from wf have "is_class P NullPointer"
    by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
  hence "preallocated h ⟹ P ⊢ typeof⇘_h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
    by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
  with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
  thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
next
  case (CallObj E e h l e' h' l' Copt M es)
  have red: "P,E ⊢ ⟨e,(h,l)⟩ → ⟨e',(h',l')⟩"
   and IH: "⋀T'. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T'⟧
                 ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
   and sconf: "P,E ⊢ (h,l) √" and wt: "P,E,h ⊢ Call e Copt M es : T" by fact+
  from wt have "P,E,h' ⊢ Call e' Copt M es : T"
  proof(cases Copt)
    case None
    with wt have "P,E,h ⊢ e∙M(es) : T" by simp
    hence "P,E,h' ⊢ e'∙M(es) : T"
    proof(rule WTrt_elim_cases)
      fix C Cs Ts Ts' m
      assume wte:"P,E,h ⊢ e : Class C"
        and "method":"P ⊢ C has least M = (Ts, T, m) via Cs"
        and wtes:"P,E,h ⊢ es [:] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
      from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT ∨ P,E,h' ⊢ e' : Class C" by auto
      thus ?thesis
      proof(rule disjE)
        assume wte':"P,E,h' ⊢ e' : NT"
        have "P,E,h' ⊢ es [:] Ts'"
          by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
        with wte' show ?thesis by(rule WTrtCallNT)
      next
        assume wte':"P,E,h' ⊢ e' : Class C"
        have wtes':"P,E,h' ⊢ es [:] Ts'"
          by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
        from wte' "method" wtes' subs show ?thesis by(rule WTrtCall)
      qed
    next
      fix Ts 
      assume wte:"P,E,h ⊢ e : NT" and wtes:"P,E,h ⊢ es [:] Ts"
      from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : NT" by simp
      have "P,E,h' ⊢ es [:] Ts"
        by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
      with wte' show ?thesis by(rule WTrtCallNT)
    qed
    with None show ?thesis by simp
  next
    case (Some C)
    with wt have "P,E,h ⊢ e∙(C::)M(es) : T" by simp
    hence "P,E,h' ⊢ e'∙(C::)M(es) : T"
    proof(rule WTrt_elim_cases)
      fix C' Cs Ts Ts' m
      assume wte:"P,E,h ⊢ e : Class C'" and path_unique:"P ⊢ Path C' to C unique"
        and "method":"P ⊢ C has least M = (Ts, T, m) via Cs"
        and wtes:"P,E,h ⊢ es [:] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
      from IH[OF sconf wte] have "P,E,h' ⊢ e' : NT ∨ P,E,h' ⊢ e' : Class C'" by auto
      thus ?thesis
      proof(rule disjE)
        assume wte':"P,E,h' ⊢ e' : NT"
        have "P,E,h' ⊢ es [:] Ts'"
          by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
        with wte' show ?thesis by(rule WTrtCallNT)
      next
        assume wte':"P,E,h' ⊢ e' : Class C'"
        have wtes':"P,E,h' ⊢ es [:] Ts'"
          by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
        from wte' path_unique "method" wtes' subs show ?thesis by(rule WTrtStaticCall)
      qed
    next
      fix Ts 
      assume wte:"P,E,h ⊢ e : NT" and wtes:"P,E,h ⊢ es [:] Ts"
      from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : NT" by simp
      have "P,E,h' ⊢ es [:] Ts"
        by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
      with wte' show ?thesis by(rule WTrtCallNT)
    qed
    with Some show ?thesis by simp
  qed
  thus ?case by (rule wt_same_type_typeconf)
next
  case (CallParams E es h l es' h' l' v Copt M)
  have reds: "P,E ⊢ ⟨es,(h,l)⟩ [→] ⟨es',(h',l')⟩"
   and IH: "⋀Ts. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ es [:] Ts⟧
                 ⟹ types_conf P E h' es' Ts"
   and sconf: "P,E ⊢ (h,l) √" and wt: "P,E,h ⊢ Call (Val v) Copt M es : T" by fact+
  from wt have "P,E,h' ⊢ Call (Val v) Copt M es' : T"
  proof(cases Copt)
    case None
    with wt have "P,E,h ⊢ (Val v)∙M(es) : T" by simp
    hence "P,E,h' ⊢ Val v∙M(es') : T"
    proof (rule WTrt_elim_cases)
      fix C Cs Ts Ts' m
      assume wte: "P,E,h ⊢ Val v : Class C"
        and "method":"P ⊢ C has least M = (Ts,T,m) via Cs"
        and wtes: "P,E,h ⊢ es [:] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
      from wtes have "length es = length Ts'" by(rule WTrts_same_length)
      with reds have "length es' = length Ts'"
        by -(drule reds_length,simp)
      with IH[OF sconf wtes] subs obtain Ts'' where wtes':"P,E,h' ⊢ es' [:] Ts''"
        and subs':"P ⊢ Ts'' [≤] Ts" by(auto dest:types_conf_smaller_types)
      have wte':"P,E,h' ⊢ Val v : Class C"
        by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
      from wte' "method" wtes' subs' show ?thesis
        by(rule WTrtCall)
    next
      fix Ts
      assume wte:"P,E,h ⊢ Val v : NT" 
        and wtes:"P,E,h ⊢ es [:] Ts"
      from wtes have "length es = length Ts" by(rule WTrts_same_length)
      with reds have "length es' = length Ts"
        by -(drule reds_length,simp)
      with IH[OF sconf wtes] obtain Ts' where wtes':"P,E,h' ⊢ es' [:] Ts'"
        and "P ⊢ Ts' [≤] Ts" by(auto dest:types_conf_smaller_types)
      have wte':"P,E,h' ⊢ Val v : NT"
        by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
      from wte' wtes' show ?thesis by(rule WTrtCallNT)
    qed
    with None show ?thesis by simp
  next
    case (Some C)
    with wt have "P,E,h ⊢ (Val v)∙(C::)M(es) : T" by simp
    hence "P,E,h' ⊢ (Val v)∙(C::)M(es') : T"
    proof(rule WTrt_elim_cases)
      fix C' Cs Ts Ts' m
      assume wte:"P,E,h ⊢ Val v : Class C'" and path_unique:"P ⊢ Path C' to C unique"
        and "method":"P ⊢ C has least M = (Ts,T,m) via Cs"
        and wtes:"P,E,h ⊢ es [:] Ts'" and subs: "P ⊢ Ts' [≤] Ts"
      from wtes have "length es = length Ts'" by(rule WTrts_same_length)
      with reds have "length es' = length Ts'"
        by -(drule reds_length,simp)
      with IH[OF sconf wtes] subs obtain Ts'' where wtes':"P,E,h' ⊢ es' [:] Ts''"
        and subs':"P ⊢ Ts'' [≤] Ts" by(auto dest:types_conf_smaller_types)
      have wte':"P,E,h' ⊢ Val v : Class C'"
        by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
      from wte' path_unique "method" wtes' subs' show ?thesis
        by(rule WTrtStaticCall)
    next
      fix Ts
      assume wte:"P,E,h ⊢ Val v : NT" 
        and wtes:"P,E,h ⊢ es [:] Ts"
      from wtes have "length es = length Ts" by(rule WTrts_same_length)
      with reds have "length es' = length Ts"
        by -(drule reds_length,simp)
      with IH[OF sconf wtes] obtain Ts' where wtes':"P,E,h' ⊢ es' [:] Ts'"
        and "P ⊢ Ts' [≤] Ts" by(auto dest:types_conf_smaller_types)
      have wte':"P,E,h' ⊢ Val v : NT"
        by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
      from wte' wtes' show ?thesis by(rule WTrtCallNT)
    qed
    with Some show ?thesis by simp
  qed
  thus ?case by (rule wt_same_type_typeconf)
next
  case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs'
                vs bs new_body E T'')
  have hp:"hp (h,l) a = Some(C,S)"
    and "method":"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
    and select:"P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
    and length1:"length vs = length pns" and length2:"length Ts = length pns"
    and bs:"bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)"
    and body_case:"new_body = (case T' of Class D ⇒ ⦇D⦈bs | _ ⇒ bs)"
    and wt:"P,E,h ⊢ ref (a,Cs)∙M(map Val vs) : T''" by fact+
  from wt hp "method" wf obtain Ts''
    where wtref:"P,E,h ⊢ ref (a,Cs) : Class (last Cs)" and eq:"T'' = T'"
    and wtes:"P,E,h ⊢ map Val vs [:] Ts''" and subs: "P ⊢ Ts'' [≤] Ts'"
    by(auto dest:wf_sees_method_fun split:if_split_asm)
  from select wf have "is_class P (last Cs')"
    by(induct rule:SelectMethodDef.induct,
       auto intro:Subobj_last_isClass simp:FinalOverriderMethodDef_def 
      OverriderMethodDefs_def MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
  with select_method_wf_mdecl[OF wf select]
  have length_pns:"length (this#pns) = length (Class(last Cs')#Ts)" 
    and notNT:"T ≠ NT" and type:"∀T∈set (Class(last Cs')#Ts). is_type P T"
    and wtabody:"P,[this↦Class(last Cs'),pns[↦]Ts] ⊢ body :: T"
    by(auto simp:wf_mdecl_def)
  from wtes hp select
  have map:"map (P ⊢ typeof⇘_h⇙) (Ref(a,Cs')#vs) = map Some (Class(last Cs')#Ts'')"
    by(auto elim:SelectMethodDef.cases split:if_split_asm 
            simp:FinalOverriderMethodDef_def OverriderMethodDefs_def 
                 MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
  from wtref hp have "P ⊢ Path C to (last Cs) via Cs"
    by (auto simp:path_via_def split:if_split_asm)
  with select "method" wf have "Ts' = Ts ∧ P ⊢ T ≤ T'"
    by -(rule select_least_methods_subtypes,simp_all)
  hence eqs:"Ts' = Ts" and sub:"P ⊢ T ≤ T'" by auto
  from wf wtabody have "P,Map.empty(this↦Class(last Cs'),pns[↦]Ts),h ⊢ body : T"
    by -(rule WT_implies_WTrt,simp_all)
  hence wtbody:"P,E(this#pns [↦] Class (last Cs')#Ts),h ⊢ body : T"
    by(rule WTrt_env_mono) simp
  from wtes have "length vs = length Ts''"
    by (fastforce dest:WTrts_same_length)
  with eqs subs
  have length_vs:"length (Ref(a,Cs')#vs) = length (Class(last Cs')#Ts)"
    by (simp add:list_all2_iff)
  from subs eqs have "P ⊢ (Class(last Cs')#Ts'') [≤] (Class(last Cs')#Ts)"
    by (simp add:fun_of_def)
  with wt_blocks[OF length_pns length_vs type] wtbody map eq
  have blocks:"P,E,h ⊢ blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body) : T"
    by auto
  have "P,E,h ⊢ new_body : T'"
  proof(cases "∀C. T' ≠ Class C")
    case True
    with sub notNT have "T = T'" by (cases T') auto
    with blocks True body_case bs show ?thesis by(cases T') auto
  next
    case False
    then obtain D where T':"T' = Class D" by auto
    with "method" sub wf have "class": "is_class P D"
      by (auto elim!:widen.cases dest:least_method_is_type 
               intro:Subobj_last_isClass simp:path_unique_def)
    with blocks T' body_case bs "class" sub show ?thesis
      by(cases T',auto,cases T,auto)
  qed
  with eq show ?case by(fastforce intro:wt_same_type_typeconf)
next
  case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a h l T')
  have "method":"P ⊢ C has least M = (Ts, T, pns, body) via Cs'"
    and length1:"length vs = length pns"
    and length2:"length Ts = length pns"
    and path_unique:"P ⊢ Path last Cs to C unique"
    and path_via:"P ⊢ Path last Cs to C via Cs''"
    and Ds:"Ds = (Cs @⇩_p Cs'') @⇩_p Cs'"
    and wt:"P,E,h ⊢ ref (a,Cs)∙(C::)M(map Val vs) : T'" by fact+
  from wt "method" wf obtain Ts'
    where wtref:"P,E,h ⊢ ref (a,Cs) : Class (last Cs)"
    and wtes:"P,E,h ⊢ map Val vs [:] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
    and TeqT':"T = T'"
    by(auto dest:wf_sees_method_fun split:if_split_asm)
  from wtref obtain D S where hp:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
    by (auto split:if_split_asm)
  from length1 length2
  have length_vs: "length (Ref(a,Ds)#vs) = length (Class (last Ds)#Ts)" by simp
  from length2 have length_pns:"length (this#pns) = length (Class (last Ds)#Ts)"
    by simp
  from "method" have "Cs' ≠ []" 
    by (fastforce intro!:Subobjs_nonempty simp add:LeastMethodDef_def MethodDefs_def)
  with Ds have last:"last Cs' = last Ds"
    by (fastforce dest:appendPath_last)
  with "method" have "is_class P (last Ds)"
    by(auto simp:LeastMethodDef_def MethodDefs_def is_class_def)
  with last has_least_wf_mdecl[OF wf "method"]
  have wtabody: "P,[this#pns [↦] Class (last Ds)#Ts] ⊢ body :: T"
    and type:"∀T∈set (Class(last Ds)#Ts). is_type P T"
    by(auto simp:wf_mdecl_def)
  from path_via have suboCs'':"Subobjs P (last Cs) Cs''" 
    and lastCs'':"last Cs'' = C" 
    by (auto simp add:path_via_def)
  with subo wf have subo':"Subobjs P D (Cs@⇩_pCs'')"
     by(fastforce intro: Subobjs_appendPath)
   from lastCs'' suboCs'' have lastC:"C = last(Cs@⇩_pCs'')"
     by (fastforce dest:Subobjs_nonempty intro:appendPath_last)
  from "method" have "Subobjs P C Cs'"
    by (auto simp:LeastMethodDef_def MethodDefs_def)
  with subo' wf lastC have "Subobjs P D ((Cs @⇩_p Cs'') @⇩_p Cs')"
    by (fastforce intro:Subobjs_appendPath)
  with Ds have suboDs:"Subobjs P D Ds" by simp
  from wtabody have "P,Map.empty(this#pns [↦] Class (last Ds)#Ts),h ⊢ body : T"
    by(rule WT_implies_WTrt)
  hence "P,E(this#pns [↦] Class (last Ds)#Ts),h ⊢ body : T"
    by(rule WTrt_env_mono) simp
  hence "P,E,h ⊢ blocks(this#pns, Class (last Ds)#Ts, Ref(a,Ds)#vs, body) : T"
    using wtes subs wt_blocks[OF length_pns length_vs type] hp suboDs
    by(auto simp add:rel_list_all2_Cons2)
  with TeqT' show ?case by(fastforce intro:wt_same_type_typeconf)
next
  case (RedCallNull E Copt M vs h l)
  have sconf:"P,E ⊢ (h, l) √" by fact
  from wf have "is_class P NullPointer" 
    by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
  hence "preallocated h ⟹ P ⊢ typeof⇘_h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
    by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
  with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
  thus ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (BlockRedNone E V T e h l e' h' l' T')
  have IH:"⋀T'. ⟦P,E(V ↦ T) ⊢ (h, l(V := None)) √; P,E(V ↦ T),h ⊢ e : T'⟧
                 ⟹ P,E(V ↦ T),h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ {V:T; e} : T'" by fact+
  from wt have type:"is_type P T" and wte:"P,E(V↦T),h ⊢ e : T'" by auto
  from sconf type have "P,E(V ↦ T) ⊢ (h, l(V := None)) √"
    by (auto simp:sconf_def lconf_def envconf_def)
  from IH[OF this wte] type show ?case by (cases T') auto
next
  case (BlockRedSome E V T e h l e' h' l' v T')
  have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V := None))⟩ → ⟨e',(h', l')⟩"
    and IH:"⋀T'. ⟦P,E(V ↦ T) ⊢ (h, l(V := None)) √; P,E(V ↦ T),h ⊢ e : T'⟧
                  ⟹ P,E(V ↦ T),h' ⊢ e' :⇘_NT⇙ T'"
    and Some:"l' V = Some v"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ {V:T; e} : T'" by fact+
  from wt have wte:"P,E(V↦T),h ⊢ e : T'"  and type:"is_type P T" by auto
  with sconf wf red type have "P,h' ⊢ l' (:≤)⇩_w E(V ↦ T)"
    by -(auto simp:sconf_def,rule red_preserves_lconf,
         auto intro:wf_prog_wwf_prog simp:envconf_def lconf_def)
  hence conf:"P,h' ⊢ v :≤ T" using Some 
    by(auto simp:lconf_def,erule_tac x="V" in allE,clarsimp)
  have wtval:"P,E(V ↦ T),h' ⊢ V:=Val v : T"
  proof(cases T)
    case Void with conf show ?thesis by auto
  next
    case Boolean with conf show ?thesis by auto
  next
    case Integer with conf show ?thesis by auto
  next
    case NT with conf show ?thesis by auto
  next
    case (Class C)
    with conf have "P,E(V ↦ T),h' ⊢ Val v : T ∨ P,E(V ↦ T),h' ⊢ Val v : NT"
      by auto
    with Class show ?thesis by auto
  qed
  from sconf type have "P,E(V ↦ T) ⊢ (h, l(V := None)) √"
    by (auto simp:sconf_def lconf_def envconf_def)
  from IH[OF this wte] wtval type show ?case by(cases T') auto
next
  case (InitBlockRed E V T e h l v' e' h' l' v'' v T')
  have red:"P,E(V ↦ T) ⊢ ⟨e,(h, l(V ↦ v'))⟩ → ⟨e',(h', l')⟩"
    and IH:"⋀T'. ⟦P,E(V ↦ T) ⊢ (h, l(V ↦ v')) √; P,E(V ↦ T),h ⊢ e : T'⟧
              ⟹ P,E(V ↦ T),h' ⊢ e' :⇘_NT⇙ T'"
    and Some:"l' V = Some v''" and casts:"P ⊢ T casts v to v'"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ {V:T := Val v; e} : T'" by fact+
  from wt have wte:"P,E(V ↦ T),h ⊢ e : T'" and wtval:"P,E(V ↦ T),h ⊢ V:=Val v : T"
    and type:"is_type P T"
    by auto
  from wf casts wtval have "P,h ⊢ v' :≤ T"
    by(fastforce intro!:casts_conf wf_prog_wwf_prog)
  with sconf have lconf:"P,h ⊢ l(V ↦ v') (:≤)⇩_w E(V ↦ T)"
    by (fastforce intro!:lconf_upd2 simp:sconf_def)
  from sconf type have "envconf P (E(V ↦ T))" by(simp add:sconf_def envconf_def)
  from red_preserves_lconf[OF wf_prog_wwf_prog[OF wf] red wte lconf this]
  have "P,h' ⊢ l' (:≤)⇩_w E(V ↦ T)" .
  with Some have "P,h' ⊢ v'' :≤ T"
    by(simp add:lconf_def,erule_tac x="V" in allE,auto)
  hence wtval':"P,E(V ↦ T),h' ⊢ V:=Val v'' : T"
    by(cases T) auto
  from lconf sconf type have "P,E(V ↦ T) ⊢ (h, l(V ↦ v')) √"
    by(auto simp:sconf_def envconf_def)
  from IH[OF this wte] wtval' type show ?case by(cases T') auto
next
  case RedBlock thus ?case by (fastforce intro:wt_same_type_typeconf)
next
  case RedInitBlock thus ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (SeqRed E e h l e' h' l' e⇩₂ T)
  have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
    and IH:"⋀T'. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T'⟧ ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T'"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ e;; e⇩₂ : T" by fact+
  from wt obtain T' where wte:"P,E,h ⊢ e : T'" and wte2:"P,E,h ⊢ e⇩₂ : T" by auto
  from WTrt_hext_mono[OF wte2 red_hext_incr[OF red]] have wte2':"P,E,h' ⊢ e⇩₂ : T" .
  from IH[OF sconf wte] obtain T'' where "P,E,h' ⊢ e' : T''" by(cases T') auto
  with wte2' have "P,E,h' ⊢ e';; e⇩₂ : T" by auto
  thus ?case by(rule wt_same_type_typeconf)
next
  case RedSeq thus ?case by (fastforce intro:wt_same_type_typeconf)
next
  case (CondRed E e h l e' h' l' e⇩₁ e⇩₂)
  have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
    and IH: "⋀T. ⟦P,E ⊢ (h,l) √; P,E,h ⊢ e : T⟧
                     ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T"
    and wt:"P,E,h ⊢ if (e) e⇩₁ else e⇩₂ : T"
    and sconf:"P,E ⊢ (h,l) √" by fact+
  from wt have wte:"P,E,h ⊢ e : Boolean"
      and wte1:"P,E,h ⊢ e⇩₁ : T" and wte2:"P,E,h ⊢ e⇩₂ : T" by auto
  from IH[OF sconf wte] have wte':"P,E,h' ⊢ e' : Boolean" by auto
  from wte' WTrt_hext_mono[OF wte1 red_hext_incr[OF red]]
    WTrt_hext_mono[OF wte2 red_hext_incr[OF red]]
  have "P,E,h' ⊢ if (e') e⇩₁ else e⇩₂ : T"
    by (rule WTrtCond)
  thus ?case by(rule wt_same_type_typeconf)
next
  case RedCondT thus ?case by (fastforce intro: wt_same_type_typeconf)
next
  case RedCondF thus ?case by (fastforce intro: wt_same_type_typeconf)
next
  case RedWhile thus ?case by (fastforce intro: wt_same_type_typeconf)
next
  case (ThrowRed E e h l e' h' l' T)
  have IH:"⋀T. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T⟧ ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ throw e : T" by fact+
  from wt obtain T' where wte:"P,E,h ⊢ e : T'" and ref:"is_refT T'"
    by auto
  from ref have "P,E,h' ⊢ throw e' : T"
  proof(rule refTE)
    assume T':"T' = NT"
    with wte have "P,E,h ⊢ e : NT" by simp
    from IH[OF sconf this] ref T' show ?thesis by auto
    
  next
    fix C assume T':"T' = Class C"
    with wte have "P,E,h ⊢ e : Class C" by simp
    from IH[OF sconf this] have "P,E,h' ⊢ e' : Class C ∨ P,E,h' ⊢ e' : NT"
      by simp
    thus ?thesis
    proof(rule disjE)
      assume wte':"P,E,h' ⊢ e' : Class C"
      have "is_refT (Class C)" by simp
      with wte' show ?thesis by auto
    next
      assume wte':"P,E,h' ⊢ e' : NT"
      have "is_refT NT" by simp
      with wte' show ?thesis by auto
    qed
  qed
  thus ?case by (rule wt_same_type_typeconf)
next
  case (RedThrowNull E h l)
  have sconf:"P,E ⊢ (h, l) √" by fact
  from wf have "is_class P NullPointer"
    by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
  hence "preallocated h ⟹ P ⊢ typeof⇘_h⇙ (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
    by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
  with sconf have "P,E,h ⊢ THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
  thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
next
  case (ListRed1 E e h l e' h' l' es Ts)
  have red:"P,E ⊢ ⟨e,(h, l)⟩ → ⟨e',(h', l')⟩"
    and IH:"⋀T. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ e : T⟧ ⟹ P,E,h' ⊢ e' :⇘_NT⇙ T"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ e # es [:] Ts" by fact+
  from wt obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
  with wt have wte:"P,E,h ⊢ e : U" and wtes:"P,E,h ⊢ es [:] Us" by simp_all
  from WTrts_hext_mono[OF wtes red_hext_incr[OF red]] 
  have wtes':"P,E,h' ⊢ es [:] Us" .
  hence "length es = length Us" by (rule WTrts_same_length)
  with wtes' have "types_conf P E h' es Us"
    by (fastforce intro:wts_same_types_typesconf)
  with IH[OF sconf wte] Ts show ?case by simp
next
  case (ListRed2 E es h l es' h' l' v Ts)
  have reds:"P,E ⊢ ⟨es,(h, l)⟩ [→] ⟨es',(h', l')⟩"
    and IH:"⋀Ts. ⟦P,E ⊢ (h, l) √; P,E,h ⊢ es [:] Ts⟧ ⟹ types_conf P E h' es' Ts"
    and sconf:"P,E ⊢ (h, l) √" and wt:"P,E,h ⊢ Val v#es [:] Ts" by fact+
  from wt obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
  with wt have wtval:"P,E,h ⊢ Val v : U" and wtes:"P,E,h ⊢ es [:] Us" by simp_all
  from WTrt_hext_mono[OF wtval reds_hext_incr[OF reds]]
  have "P,E,h' ⊢ Val v : U" .
  hence "P,E,h' ⊢ (Val v) :⇘_NT⇙ U" by(rule wt_same_type_typeconf)
  with IH[OF sconf wtes] Ts show ?case by simp
next
  case (CallThrowObj E h l Copt M es h' l')
  thus ?case by(cases Copt)(auto intro:wt_same_type_typeconf)
next
  case (CallThrowParams es vs h l es' E v Copt M h' l')
  thus ?case by(cases Copt)(auto intro:wt_same_type_typeconf)
qed (fastforce intro:wt_same_type_typeconf)+



corollary subject_reduction:
  "⟦ wf_C_prog P; P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩; P,E ⊢ s √; P,E,hp s ⊢ e:T ⟧
  ⟹ P,E,(hp s') ⊢ e' :⇘_NT⇙ T"
by(cases s, cases s', fastforce dest:subject_reduction2)

corollary subjects_reduction:
  "⟦ wf_C_prog P; P,E ⊢ ⟨es,s⟩ [→] ⟨es',s'⟩; P,E ⊢ s √; P,E,hp s ⊢ es[:]Ts ⟧
  ⟹ types_conf P E (hp s') es' Ts"
by(cases s, cases s', fastforce dest:subjects_reduction2)


subsection ‹Lifting to ‹→*››

text‹Now all these preservation lemmas are first lifted to the transitive
closure \dots›

lemma step_preserves_sconf:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "⋀T. ⟦ P,E,hp s ⊢ e : T; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"

using step
proof (induct rule:converse_rtrancl_induct2)
  case refl show ?case by fact 
next
  case step
  thus ?case using wf
    apply simp
    apply (frule subject_reduction[OF wf])
      apply (rule step.prems)
      apply (rule step.prems)
      apply (cases T)
      apply (auto dest:red_preserves_sconf intro:wf_prog_wwf_prog)
      done
qed

lemma steps_preserves_sconf:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
shows "⋀Ts. ⟦ P,E,hp s ⊢ es [:] Ts; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"

using step
proof (induct rule:converse_rtrancl_induct2)
  case refl show ?case by fact
next
  case (step es s es'' s'' Ts)
  have Reds:"((es, s), es'', s'') ∈ Reds P E"
    and reds:"P,E ⊢ ⟨es'',s''⟩ [→]* ⟨es',s'⟩"
    and wtes:"P,E,hp s ⊢ es [:] Ts"
    and sconf:"P,E ⊢ s √"
    and IH:"⋀Ts. ⟦P,E,hp s'' ⊢ es'' [:] Ts; P,E ⊢ s'' √⟧ ⟹ P,E ⊢ s' √" by fact+
  from Reds have reds1:"P,E ⊢ ⟨es,s⟩ [→] ⟨es'',s''⟩" by simp
  from subjects_reduction[OF wf this sconf wtes] 
  have type:"types_conf P E (hp s'') es'' Ts" .
  from reds1 wtes sconf wf have sconf':"P,E ⊢ s'' √" 
    by(fastforce intro:wf_prog_wwf_prog reds_preserves_sconf)
  from type have "∃Ts'. P,E,hp s'' ⊢ es'' [:] Ts'"
  proof (induct Ts arbitrary: es'')
    fix esi
    assume "types_conf P E (hp s'') esi []"
    thus "∃Ts'. P,E,hp s'' ⊢ esi [:] Ts'"
    proof(induct esi)
      case Nil thus "∃Ts'. P,E,hp s'' ⊢ [] [:] Ts'" by simp
    next
      fix ex esx
      assume "types_conf P E (hp s'') (ex#esx) []"
      thus "∃Ts'. P,E,hp s'' ⊢ ex#esx [:] Ts'" by simp
    qed
  next
    fix T' Ts' esi
    assume type':"types_conf P E (hp s'') esi (T'#Ts')"
      and IH:"⋀es''. types_conf P E (hp s'') es'' Ts' ⟹
                      ∃Ts''. P,E,hp s'' ⊢ es'' [:] Ts''"
    from type' show "∃Ts'. P,E,hp s'' ⊢ esi [:] Ts'"
    proof(induct esi)
      case Nil thus "∃Ts'. P,E,hp s'' ⊢ [] [:] Ts'" by simp
    next
      fix ex esx
      assume "types_conf P E (hp s'') (ex#esx) (T'#Ts')"
      hence type':"P,E,hp s'' ⊢ ex :⇘_NT⇙ T'" 
        and types':"types_conf P E (hp s'') esx Ts'" by simp_all
      from type' obtain Tx where type'':"P,E,hp s'' ⊢ ex : Tx"
        by(cases T') auto
      from IH[OF types'] obtain Tsx where "P,E,hp s'' ⊢ esx [:] Tsx" by auto
      with type'' show "∃Ts'. P,E,hp s'' ⊢ ex#esx [:] Ts'" by auto
    qed
  qed
  then obtain Ts' where "P,E,hp s'' ⊢ es'' [:] Ts'" by blast
  from IH[OF this sconf'] show ?case .
qed


lemma step_preserves_defass:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "𝒟 e ⌊dom(lcl s)⌋ ⟹ 𝒟 e' ⌊dom(lcl s')⌋"

using step
proof (induct rule:converse_rtrancl_induct2)
  case refl thus ?case .
next
  case (step e s e' s') thus ?case
    by(cases s,cases s')(auto dest:red_preserves_defass[OF wf])
qed



lemma step_preserves_type:
assumes wf: "wf_C_prog P" and step: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "⋀T. ⟦ P,E ⊢ s √; P,E,hp s ⊢ e:T ⟧
    ⟹ P,E,(hp s') ⊢ e' :⇘_NT⇙ T"

using step
proof (induct rule:converse_rtrancl_induct2)
  case refl thus ?case by -(rule wt_same_type_typeconf)
next
  case (step e s e'' s'' T) thus ?case using wf
    apply simp
    apply (frule subject_reduction[OF wf])
    apply (auto dest!:red_preserves_sconf intro:wf_prog_wwf_prog)
    apply(cases T)
    apply fastforce+
    done
qed


text‹predicate to show the same lemma for lists›

fun
  conformable :: "ty list ⇒ ty list ⇒ bool"
where
  "conformable [] [] ⟷ True"
  | "conformable (T''#Ts'') (T'#Ts') ⟷ (T'' = T'
     ∨ (∃C. T'' = NT ∧ T' = Class C)) ∧ conformable Ts'' Ts'"
  | "conformable _ _ ⟷ False"

lemma types_conf_conf_types_conf:
  "⟦types_conf P E h es Ts; conformable Ts Ts'⟧ ⟹ types_conf P E h es Ts'"
proof (induct Ts arbitrary: Ts' es)
  case Nil thus ?case by (cases Ts') (auto split: if_split_asm)
next
  case (Cons T'' Ts'')
  have type:"types_conf P E h es (T''#Ts'')"
    and conf:"conformable (T''#Ts'') Ts'"
    and IH:"⋀Ts' es. ⟦types_conf P E h es Ts''; conformable Ts'' Ts'⟧
                   ⟹ types_conf P E h es Ts'" by fact+
  from type obtain e' es' where es:"es = e'#es'" by (cases es) auto
  with type have type':"P,E,h ⊢ e' :⇘_NT⇙ T''"
    and types': "types_conf P E h es' Ts''"
    by simp_all
  from conf obtain U Us where Ts': "Ts' = U#Us" by (cases Ts') auto
  with conf have disj:"T'' = U ∨ (∃C. T'' = NT ∧ U = Class C)"
    and conf':"conformable Ts'' Us"
    by simp_all
  from type' disj have "P,E,h ⊢ e' :⇘_NT⇙ U" by auto
  with IH[OF types' conf'] Ts' es show ?case by simp
qed


lemma types_conf_Wtrt_conf:
  "types_conf P E h es Ts ⟹ ∃Ts'. P,E,h ⊢ es [:] Ts' ∧ conformable Ts' Ts"
proof (induct Ts arbitrary: es)
  case Nil thus ?case by (cases es) (auto split:if_split_asm)
next
  case (Cons T'' Ts'')
  have type:"types_conf P E h es (T''#Ts'')"
    and IH:"⋀es. types_conf P E h es Ts'' ⟹
                  ∃Ts'. P,E,h ⊢ es [:] Ts' ∧ conformable Ts' Ts''" by fact+
  from type obtain e' es' where es:"es = e'#es'" by (cases es) auto
  with type have type':"P,E,h ⊢ e' :⇘_NT⇙ T''"
    and types': "types_conf P E h es' Ts''"
    by simp_all
  from type' obtain T' where "P,E,h ⊢ e' : T'" and 
    "T' = T'' ∨ (∃C. T' = NT ∧ T'' = Class C)" by(cases T'') auto
  with IH[OF types'] es show ?case 
    by(auto,rule_tac x="T''#Ts'" in exI,simp,rule_tac x="NT#Ts'" in exI,simp)
qed



lemma steps_preserves_types:
assumes wf: "wf_C_prog P" and steps: "P,E ⊢ ⟨es,s⟩ [→]* ⟨es',s'⟩"
shows "⋀Ts. ⟦ P,E ⊢ s √; P,E,hp s ⊢ es [:] Ts⟧
  ⟹ types_conf P E (hp s') es' Ts"
  
using steps
proof (induct rule:converse_rtrancl_induct2)
  case refl thus ?case by -(rule wts_same_types_typesconf)
next
  case (step es s es'' s'' Ts)
  have Reds:"((es, s), es'', s'') ∈ Reds P E"
    and steps:"P,E ⊢ ⟨es'',s''⟩ [→]* ⟨es',s'⟩"
    and sconf:"P,E ⊢ s √" and wtes:"P,E,hp s ⊢ es [:] Ts"
    and IH:"⋀Ts. ⟦P,E ⊢ s'' √; P,E,hp s'' ⊢ es'' [:] Ts ⟧ 
               ⟹ types_conf P E (hp s') es' Ts" by fact+
  from Reds have step:"P,E ⊢ ⟨es,s⟩ [→] ⟨es'',s''⟩" by simp
  with wtes sconf wf have sconf':"P,E ⊢ s'' √"
    by(auto intro:reds_preserves_sconf wf_prog_wwf_prog)
  from wtes have "length es = length Ts" by(fastforce dest:WTrts_same_length)
  from step sconf wtes
  have type': "types_conf P E (hp s'') es'' Ts"
    by (rule subjects_reduction[OF wf])
  then obtain Ts' where wtes'':"P,E,hp s'' ⊢ es'' [:] Ts'" 
    and conf:"conformable Ts' Ts" by (auto dest:types_conf_Wtrt_conf)
  from IH[OF sconf' wtes''] have "types_conf P E (hp s') es' Ts'" .
  with conf show ?case by(fastforce intro:types_conf_conf_types_conf)
qed
  

subsection ‹Lifting to ‹⇒››

text‹\dots and now to the big step semantics, just for fun.›

lemma eval_preserves_sconf:
  "⟦ wf_C_prog P; P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩; P,E ⊢ e::T; P,E ⊢ s √ ⟧ ⟹ P,E ⊢ s' √"

by(blast intro:step_preserves_sconf big_by_small WT_implies_WTrt wf_prog_wwf_prog)

lemma evals_preserves_sconf:
  "⟦ wf_C_prog P; P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩; P,E ⊢ es [::] Ts; P,E ⊢ s √ ⟧ 
  ⟹ P,E ⊢ s' √"
  by(blast intro:steps_preserves_sconf bigs_by_smalls WTs_implies_WTrts 
                 wf_prog_wwf_prog)



lemma eval_preserves_type: assumes wf: "wf_C_prog P"
shows "⟦ P,E ⊢ ⟨e,s⟩ ⇒ ⟨e',s'⟩; P,E ⊢ s √; P,E ⊢ e::T ⟧
   ⟹ P,E,(hp s') ⊢ e' :⇘_NT⇙ T"

  using wf
  by (auto dest!:big_by_small[OF wf_prog_wwf_prog[OF wf]] WT_implies_WTrt 
           intro:wf_prog_wwf_prog
           dest!:step_preserves_type[OF wf])


lemma evals_preserves_types: assumes wf: "wf_C_prog P"
shows "⟦ P,E ⊢ ⟨es,s⟩ [⇒] ⟨es',s'⟩; P,E ⊢ s √; P,E ⊢ es [::] Ts ⟧
  ⟹ types_conf P E (hp s') es' Ts"
using wf
  by (auto dest!:bigs_by_smalls[OF wf_prog_wwf_prog[OF wf]] WTs_implies_WTrts
           intro:wf_prog_wwf_prog
           dest!:steps_preserves_types[OF wf])


subsection ‹The final polish›

text‹The above preservation lemmas are now combined and packed nicely.›

definition wf_config :: "prog ⇒ env ⇒ state ⇒ expr ⇒ ty ⇒ bool" ("_,_,_ ⊢ _ : _ √"   [51,0,0,0,0]50) where
  "P,E,s ⊢ e:T √  ≡  P,E ⊢ s √ ∧ P,E,hp s ⊢ e : T"

theorem Subject_reduction: assumes wf: "wf_C_prog P"
shows "P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩ ⟹ P,E,s ⊢ e : T √
       ⟹ P,E,(hp s') ⊢ e' :⇘_NT⇙ T"

  using wf
  by (force elim!:red_preserves_sconf intro:wf_prog_wwf_prog 
            dest:subject_reduction[OF wf] simp:wf_config_def)



theorem Subject_reductions:
assumes wf: "wf_C_prog P" and reds: "P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
shows "⋀T. P,E,s ⊢ e : T √ ⟹ P,E,(hp s') ⊢ e' :⇘_NT⇙ T"

using reds
proof (induct rule:converse_rtrancl_induct2)
  case refl thus ?case
    by (fastforce intro:wt_same_type_typeconf simp:wf_config_def)
next
  case (step e s e'' s'' T)
  have Red:"((e, s), e'', s'') ∈ Red P E"
    and IH:"⋀T. P,E,s'' ⊢ e'' : T √ ⟹ P,E,(hp s') ⊢ e' :⇘_NT⇙ T"
    and wte:"P,E,s ⊢ e : T √" by fact+
  from Red have red:"P,E ⊢ ⟨e,s⟩ → ⟨e'',s''⟩" by simp
  from red_preserves_sconf[OF red] wte wf have sconf:"P,E ⊢ s'' √"
    by(fastforce dest:wf_prog_wwf_prog simp:wf_config_def)
  from wf red wte have type_conf:"P,E,(hp s'') ⊢ e'' :⇘_NT⇙ T"
    by(rule Subject_reduction)
  show ?case
  proof(cases T)
    case Void
    with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
    with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
    from IH[OF this] show ?thesis .
  next
    case Boolean
    with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
    with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
    from IH[OF this] show ?thesis .
  next
    case Integer
    with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
    with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
    from IH[OF this] show ?thesis .
  next
    case NT
    with type_conf have "P,E,hp s'' ⊢ e'' : T" by simp
    with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
    from IH[OF this] show ?thesis .
  next
    case (Class C)
    with type_conf have "P,E,hp s'' ⊢ e'' : T ∨ P,E,hp s'' ⊢ e'' : NT" by simp
    thus ?thesis
    proof(rule disjE)
      assume "P,E,hp s'' ⊢ e'' : T"
      with sconf have "P,E,s'' ⊢ e'' : T √" by(simp add:wf_config_def)
      from IH[OF this] show ?thesis .
    next
      assume "P,E,hp s'' ⊢ e'' : NT"
      with sconf have "P,E,s'' ⊢ e'' : NT √" by(simp add:wf_config_def)
      from IH[OF this] have "P,E,hp s' ⊢ e' : NT" by simp
      with Class show ?thesis by simp
    qed
  qed
qed



corollary Progress: assumes wf: "wf_C_prog P"
shows "⟦ P,E,s  ⊢ e : T √; 𝒟 e ⌊dom(lcl s)⌋; ¬ final e ⟧ ⟹ ∃e' s'. P,E ⊢ ⟨e,s⟩ → ⟨e',s'⟩"

using progress[OF wf_prog_wwf_prog[OF wf]]
by(auto simp:wf_config_def sconf_def)


corollary TypeSafety:
fixes s s' :: state
assumes wf:"wf_C_prog P" and sconf:"P,E ⊢ s √" and wte:"P,E ⊢ e :: T"
  and D:"𝒟 e ⌊dom(lcl s)⌋" and step:"P,E ⊢ ⟨e,s⟩ →* ⟨e',s'⟩"
  and nored:"¬(∃e'' s''. P,E ⊢ ⟨e',s'⟩ → ⟨e'',s''⟩)"
shows "(∃v. e' = Val v ∧ P,hp s' ⊢ v :≤ T) ∨
      (∃r. e' = Throw r ∧ the_addr (Ref r) ∈ dom(hp s'))"
proof -
  from sconf wte wf have wf_config:"P,E,s ⊢ e : T √"
    by(fastforce intro:WT_implies_WTrt simp:wf_config_def)
  with wf step have type_conf:"P,E,(hp s') ⊢ e' :⇘_NT⇙ T"
    by(rule Subject_reductions)
  from step_preserves_sconf[OF wf step wte[THEN WT_implies_WTrt] sconf] wf
  have sconf':"P,E ⊢ s' √" by simp
  from wf step D have D':"𝒟 e' ⌊dom(lcl s')⌋" by(rule step_preserves_defass)
  show ?thesis
  proof(cases T)
    case Void 
    with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
    with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
    { assume "¬ final e'"
      from Progress[OF wf wf_config' D' this] nored have False
        by simp }
    hence "final e'" by fast
    with wte' show ?thesis by(auto simp:final_def)
  next
    case Boolean
    with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
    with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
    { assume "¬ final e'"
      from Progress[OF wf wf_config' D' this] nored have False
        by simp }
    hence "final e'" by fast
    with wte' show ?thesis by(auto simp:final_def)
  next
    case Integer
    with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
    with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
    { assume "¬ final e'"
      from Progress[OF wf wf_config' D' this] nored have False
        by simp }
    hence "final e'" by fast
    with wte' show ?thesis by(auto simp:final_def)
  next
    case NT
    with type_conf have wte':"P,E,hp s' ⊢ e' : T" by simp
    with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
    { assume "¬ final e'"
      from Progress[OF wf wf_config' D' this] nored have False
        by simp }
    hence "final e'" by fast
    with wte' show ?thesis by(auto simp:final_def)
  next
    case (Class C)
    with type_conf have wte':"P,E,hp s' ⊢ e' : T ∨ P,E,hp s' ⊢ e' : NT" by simp
    thus ?thesis
    proof(rule disjE)
      assume wte':"P,E,hp s' ⊢ e' : T"
      with sconf' have wf_config':"P,E,s' ⊢ e' : T √" by(simp add:wf_config_def)
      { assume "¬ final e'"
        from Progress[OF wf wf_config' D' this] nored have False
          by simp }
      hence "final e'" by fast
      with wte' show ?thesis by(auto simp:final_def)
    next
      assume wte':"P,E,hp s' ⊢ e' : NT"
      with sconf' have wf_config':"P,E,s' ⊢ e' : NT √" by(simp add:wf_config_def)
      { assume "¬ final e'"
        from Progress[OF wf wf_config' D' this] nored have False
          by simp }
      hence "final e'" by fast
      with wte' Class show ?thesis by(auto simp:final_def)
    qed
  qed
qed



end

Theory Determinism

(*  Title:       CoreC++
    Author:      Daniel Wasserrab
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
*)

section ‹Determinism Proof›

theory Determinism
imports TypeSafe
begin

subsection‹Some lemmas›

lemma maps_nth:
  "⟦(E(xs [↦] ys)) x = Some y; length xs = length ys; distinct xs⟧ 
  ⟹ ∀i. x = xs!i ∧ i < length xs ⟶ y = ys!i"
proof (induct xs arbitrary: ys E)
  case Nil thus ?case by simp
next
  case (Cons x' xs')
  have map:"(E(x' # xs' [↦] ys)) x = Some y"
    and length:"length (x'#xs') = length ys"
    and dist:"distinct (x'#xs')"
    and IH:"⋀ys E. ⟦(E(xs' [↦] ys)) x = Some y; length xs' = length ys; 
                     distinct xs'⟧ 
         ⟹ ∀i. x = xs'!i ∧ i < length xs' ⟶ y = ys!i" by fact+
  from length obtain y' ys' where ys:"ys = y'#ys'" by(cases ys) auto
  { fix i assume x:"x = (x'#xs')!i" and i:"i < length(x'#xs')"
    have "y = ys!i"
    proof(cases i)
      case 0 with x map ys dist show ?thesis by simp
    next
      case (Suc n)
      with x i have x':"x = xs'!n" and n:"n < length xs'" by simp_all
      from map ys have map':"(E(x' ↦ y')(xs' [↦] ys')) x = Some y" by simp
      from length ys have length':"length xs' = length ys'" by simp
      from dist have dist':"distinct xs'" by simp
      from IH[OF map' length' dist'] 
      have "∀i. x = xs'!i ∧ i < length xs' ⟶ y = ys'!i" .
      with x' n have "y = ys'!n" by simp
      with ys n Suc show ?thesis by simp
    qed }
  thus ?case by simp
qed


lemma nth_maps:"⟦length pns = length Ts; distinct pns; i < length Ts⟧ 
  ⟹ (E(pns [↦] Ts)) (pns!i) = Some (Ts!i)"
proof (induct i arbitrary: E pns Ts)
  case 0
  have dist:"distinct pns" and length:"length pns = length Ts"
    and i_length:"0 < length Ts" by fact+
  from i_length obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
  with length obtain p' pns' where "pns = p'#pns'" by(cases pns) auto
  with Ts dist show ?case by simp
next
  case (Suc n)
  have i_length:"Suc n < length Ts" and dist:"distinct pns"
    and length:"length pns = length Ts" by fact+
  from Suc obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
  with length obtain p' pns' where pns:"pns = p'#pns'" by(cases pns) auto
  with Ts length dist have length':"length pns' = length Ts'" 
    and dist':"distinct pns'" and notin:"p' ∉ set pns'" by simp_all
  from i_length Ts have n_length:"n < length Ts'" by simp
  with length' dist' have map:"(E(p' ↦ T')(pns' [↦] Ts')) (pns'!n) = Some(Ts'!n)" by fact
  with notin have "(E(p' ↦ T')(pns' [↦] Ts')) p' = Some T'" by simp
  with pns Ts map show ?case by simp
qed

lemma casts_casts_eq_result:
  fixes s :: state
  assumes casts:"P ⊢ T casts v to v'" and casts':"P ⊢ T casts v to w'" 
  and type:"is_type P T" and wte:"P,E ⊢ e :: T'" and leq:"P ⊢ T' ≤ T"
  and eval:"P,E ⊢ ⟨e,s⟩ ⇒ ⟨Val v,(h,l)⟩" and sconf:"P,E ⊢ s √"
  and wf:"wf_C_prog P"
  shows "v' = w'"
proof(cases "∀C. T ≠ Class C")
  case True
  with casts casts' show ?thesis
    by(auto elim:casts_to.cases)
next
  case False
  then obtain C where T:"T = Class C" by auto
  with type have "is_class P C" by simp
  with wf T leq have "T' = NT ∨ (∃D. T' = Class D ∧ P ⊢ Path D to C unique)"
    by(simp add:widen_Class)
  thus ?thesis
  proof(rule disjE)
    assume "T' = NT"
    with wf eval sconf wte have "v = Null"
      by(fastforce dest:eval_preserves_type)
    with casts casts' show ?thesis by(fastforce elim:casts_to.cases)
  next
    assume "∃D. T' = Class D ∧ P ⊢ Path D to C unique"
    then obtain D where T':"T' = Class D" 
      and path_unique:"P ⊢ Path D to C unique" by auto
    with wf eval sconf wte
    have "P,E,h ⊢ Val v : T' ∨ P,E,h ⊢ Val v : NT"
      by(fastforce dest:eval_preserves_type)
    thus ?thesis
    proof(rule disjE)
      assume "P,E,h ⊢ Val v : T'"
      with T' obtain a Cs C' S where h:"h a = Some(C',S)" and v:"v = Ref(a,Cs)"
        and last:"last Cs = D"
        by(fastforce dest:typeof_Class_Subo)
      from casts' v last T obtain Cs' Ds where "P ⊢ Path D to C via Cs'"
        and "Ds = Cs@⇩_pCs'" and "w' = Ref(a,Ds)"
        by(auto elim:casts_to.cases)
      with casts T v last path_unique show ?thesis
        by auto(erule casts_to.cases,auto simp:path_via_def path_unique_def)
    next
      assume "P,E,h ⊢ Val v : NT"
      with wf eval sconf wte have "v = Null"
        by(fastforce dest:eval_preserves_type)
      with casts casts' show ?thesis by(fastforce elim:casts_to.cases)
    qed
  qed
qed

lemma Casts_Casts_eq_result:
  assumes wf:"wf_C_prog P"
  shows "⟦P ⊢ Ts Casts vs to vs'; P ⊢ Ts Casts vs to ws'; ∀T ∈ set Ts. is_type P T;
          P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h,l)⟩;
          P,E ⊢ s √⟧
      ⟹ vs' = ws'"
proof (induct vs arbitrary: vs' ws' Ts Ts' es s)
  case Nil thus ?case by (auto elim!:Casts_to.cases)
next
  case (Cons x xs)
  have CastsCons:"P ⊢ Ts Casts x # xs to vs'" 
    and CastsCons':"P ⊢ Ts Casts x # xs to ws'"
    and type:"∀T ∈ set Ts. is_type P T" 
    and wtes:"P,E ⊢ es [::] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
    and evals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val (x#xs),(h,l)⟩"
    and sconf:"P,E ⊢ s √"
    and IH:"⋀vs' ws' Ts Ts' es s. 
    ⟦P ⊢ Ts Casts xs to vs'; P ⊢ Ts Casts xs to ws'; ∀T ∈ set Ts. is_type P T; 
     P,E ⊢ es [::] Ts'; P ⊢ Ts' [≤] Ts; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val xs,(h,l)⟩;
     P,E ⊢ s √⟧ 
     ⟹ vs' = ws'" by fact+
  from CastsCons obtain y ys S Ss where vs':"vs' = y#ys" and Ts:"Ts = S#Ss"
    apply -
    apply(frule length_Casts_vs,cases Ts,auto)
    apply(frule length_Casts_vs',cases vs',auto)
    done
  with CastsCons have casts:"P ⊢ S casts x to y" and Casts:"P ⊢ Ss Casts xs to ys"
    by(auto elim:Casts_to.cases)
  from Ts type have type':"is_type P S" and types':"∀T ∈ set Ss. is_type P T"
    by auto
  from Ts CastsCons' obtain z zs where ws':"ws' = z#zs"
    by simp(frule length_Casts_vs',cases ws',auto)
  with Ts CastsCons' have casts':"P ⊢ S casts x to z" 
    and Casts':"P ⊢ Ss Casts xs to zs"
    by(auto elim:Casts_to.cases)
  from Ts subs obtain U Us where Ts':"Ts' = U#Us" and subs':"P ⊢ Us [≤] Ss"
    and sub:"P ⊢ U ≤ S" by(cases Ts',auto simp:fun_of_def)
  from wtes Ts' obtain e' es' where es:"es = e'#es'" and wte':"P,E ⊢ e' :: U"
    and wtes':"P,E ⊢ es' [::] Us" by(cases es) auto
  with evals obtain h' l' where eval:"P,E ⊢ ⟨e',s⟩ ⇒ ⟨Val x,(h',l')⟩"
    and evals':"P,E ⊢ ⟨es',(h',l')⟩ [⇒] ⟨map Val xs,(h,l)⟩"
    by (auto elim:evals.cases)
  from wf eval wte' sconf have "P,E ⊢ (h',l') √" by(rule eval_preserves_sconf)
  from IH[OF Casts Casts' types' wtes' subs' evals' this] have eq:"ys = zs" .
  from casts casts' type' wte' sub eval sconf wf have "y = z"
    by(rule casts_casts_eq_result)
  with eq vs' ws' show ?case by simp
qed



lemma Casts_conf: assumes wf: "wf_C_prog P"
  shows "P ⊢ Ts Casts vs to vs' ⟹ 
  (⋀es s Ts'. ⟦ P,E ⊢ es [::] Ts'; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h,l)⟩; P,E ⊢ s √;
             P ⊢ Ts' [≤] Ts⟧ ⟹ 
     ∀i < length Ts. P,h ⊢ vs'!i :≤ Ts!i)"
proof(induct rule:Casts_to.induct)
  case Casts_Nil thus ?case by simp
next
  case (Casts_Cons T v v' Ts vs vs')
  have casts:"P ⊢ T casts v to v'" and wtes:"P,E ⊢ es [::] Ts'" 
    and evals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val (v#vs),(h,l)⟩"
    and subs:"P ⊢ Ts' [≤] (T#Ts)" and sconf:"P,E ⊢ s √"
    and IH:"⋀es s Ts'.⟦P,E ⊢ es [::] Ts'; P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val vs,(h,l)⟩; 
                   P,E ⊢ s √; P ⊢ Ts' [≤] Ts⟧
               ⟹ ∀i<length Ts. P,h ⊢ vs' ! i :≤ Ts ! i" by fact+
  from subs obtain U Us where Ts':"Ts' = U#Us" by(cases Ts') auto
  with subs have sub':"P ⊢ U ≤ T" and subs':"P ⊢ Us [≤] Ts" 
    by (simp_all add:fun_of_def)
  from wtes Ts' obtain e' es' where es:"es = e'#es'" by(cases es) auto
  with Ts' wtes have wte':"P,E ⊢ e' :: U" and wtes':"P,E ⊢ es' [::] Us" by auto
  from es evals obtain s' where eval':"P,E ⊢ ⟨e',s⟩ ⇒ ⟨Val v,s'⟩"
    and evals':"P,E ⊢ ⟨es',s'⟩ [⇒] ⟨map Val vs,(h,l)⟩" 
    by(auto elim:evals.cases)
  from wf eval' wte' sconf have sconf':"P,E ⊢ s' √" by(rule eval_preserves_sconf)
  from evals' have hext:"hp s' ⊴ h" by(cases s',auto intro:evals_hext)
  from wf eval' sconf wte' have "P,E,(hp s') ⊢ Val v :⇘_NT⇙ U"
    by(rule eval_preserves_type)
  with hext have wtrt:"P,E,h ⊢ Val v :⇘_NT⇙ U"
    by(cases U,auto intro:hext_typeof_mono)
  from casts wtrt sub' have "P,h ⊢ v' :≤ T"
  proof(induct rule:casts_to.induct)
    case (casts_prim T'' v'')
    have "∀C. T'' ≠ Class C" and "P,E,h ⊢ Val v'' :⇘_NT⇙ U" and "P ⊢ U ≤ T''" by fact+
    thus ?case by(cases T'') auto
  next
    case (casts_null C) thus ?case by simp
  next
    case (casts_ref Cs C Cs' Ds a)
    have path:"P ⊢ Path last Cs to C via Cs'"
      and Ds:"Ds = Cs @⇩_p Cs'"
      and wtref:"P,E,h ⊢ ref (a, Cs) :⇘_NT⇙ U" by fact+
    from wtref obtain D S where subo:"Subobjs P D Cs" and h:"h a = Some(D,S)"
      by(cases U,auto split:if_split_asm)
    from path Ds have last:"C = last Ds"  
      by(fastforce intro!:appendPath_last Subobjs_nonempty simp:path_via_def)
    from subo path Ds wf have "Subobjs P D Ds"
      by(fastforce intro:Subobjs_appendPath simp:path_via_def)
    with last h show ?case by simp
  qed
  with IH[OF wtes' evals' sconf' subs'] show ?case
    by(auto simp:nth_Cons,case_tac i,auto)
qed


lemma map_Val_throw_False:"map Val vs = map Val ws @ throw ex # es ⟹ False"
proof (induct vs arbitrary: ws)
  case Nil thus ?case by simp
next
  case (Cons v' vs')
  have eq:"map Val (v'#vs') = map Val ws @ throw ex # es"
    and IH:"⋀ws'. map Val vs' = map Val ws' @ throw ex # es ⟹ False" by fact+
  from eq obtain w' ws' where ws:"ws = w'#ws'" by(cases ws) auto
  from eq have "tl(map Val (v'#vs')) = tl(map Val ws @ throw ex # es)" by simp
  hence "map Val vs' = tl(map Val ws @ throw ex # es)" by simp
  with ws have "map Val vs' = map Val ws' @ throw ex # es" by simp
  from IH[OF this] show ?case .
qed

lemma map_Val_throw_eq:"map Val vs @ throw ex # es = map Val ws @ throw ex' # es' 
  ⟹ vs = ws ∧ ex = ex' ∧ es = es'"
  apply(clarsimp simp:append_eq_append_conv2)
  apply(erule disjE)
   apply(case_tac us)
    apply(fastforce elim:map_injective simp:inj_on_def)
   apply(fastforce dest:map_Val_throw_False)
  apply(case_tac us)
   apply(fastforce elim:map_injective simp:inj_on_def)
  apply(fastforce dest:sym[THEN map_Val_throw_False])
  done


subsection ‹The proof›

lemma deterministic_big_step:
assumes wf:"wf_C_prog P"
shows "P,E ⊢ ⟨e,s⟩ ⇒ ⟨e⇩₁,s⇩₁⟩ ⟹ 
       (⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s √⟧ 
       ⟹ e⇩₁ = e⇩₂ ∧ s⇩₁ = s⇩₂)"
  and "P,E ⊢ ⟨es,s⟩ [⇒] ⟨es⇩₁,s⇩₁⟩ ⟹ 
       (⋀es⇩₂ s⇩₂ Ts. ⟦P,E ⊢ ⟨es,s⟩ [⇒] ⟨es⇩₂,s⇩₂⟩; P,E ⊢ es [::] Ts; P,E ⊢ s √⟧ 
        ⟹ es⇩₁ = es⇩₂ ∧ s⇩₁ = s⇩₂)"
proof (induct rule:eval_evals.inducts)
  case New thus ?case by(auto elim: eval_cases)
next
  case NewFail thus ?case by(auto elim: eval_cases)
next
  case (StaticUpCast E e s⇩₀ a Cs s⇩₁ C Cs' Ds e⇩₂ s⇩₂)
  have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and path_via:"P ⊢ Path last Cs to C via Cs'" and Ds:"Ds = Cs @⇩_p Cs'" 
    and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
            ⟹ ref (a,Cs) = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where "class":"is_class P C" and wte:"P,E ⊢ e :: Class D"
    and disj:"P ⊢ Path D to C unique ∨ 
              (P ⊢ C ≼⇧^* D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩_R P C Cs))"
    by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
      and path_via':"P ⊢ Path last Xs to C via Xs'"
      and ref:"e⇩₂ = ref (a',Xs@⇩_pXs')"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂" by simp
    with wf eval_ref sconf wte have last:"last Cs = D"
      by(auto dest:eval_preserves_type split:if_split_asm)
    from disj show "ref (a,Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂"
    proof (rule disjE)
      assume "P ⊢ Path D to C unique"
      with path_via path_via' eq last have "Cs' = Xs'"
        by(fastforce simp add:path_via_def path_unique_def)
      with eq ref Ds show ?thesis by simp
    next
      assume "P ⊢ C ≼⇧^* D ∧ (∀Cs. P ⊢ Path C to D via Cs  ⟶ Subobjs⇩_R P C Cs)"
      with "class" wf obtain Cs'' where "P ⊢ Path C to D via Cs''"
        by(auto dest:leq_implies_path)
      with path_via path_via' wf eq last have "Cs' = Xs'"
        by(auto dest:path_via_reverse)
      with eq ref Ds show ?thesis by simp
    qed
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
      and ref:"e⇩₂ = ref (a',Xs@[C])"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ s⇩₁ = s⇩₂" by simp
    with wf eval_ref sconf wte obtain C' where 
      last:"last Cs = D" and "Subobjs P C' (Xs@C#Xs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    hence subo:"Subobjs P C (C#Xs')" by(fastforce intro:Subobjs_Subobjs)
    with eq last have leq:"P ⊢ C ≼⇧^* D" by(fastforce dest:Subobjs_subclass)
    from path_via last have "P ⊢ D ≼⇧^* C"
      by(auto dest:Subobjs_subclass simp:path_via_def)
    with leq wf have CeqD:"C = D" by(rule subcls_asym2)
    with last path_via wf have "Cs' = [D]" by(fastforce intro:path_via_C)
    with Ds last have Ds':"Ds = Cs" by(simp add:appendPath_def)
    from subo CeqD last eq wf have "Xs' = []" by(auto dest:mdc_eq_last)
    with eq Ds' ref show "ref (a,Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "ref (a,Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩" and notin:"C ∉ set Xs"
      and notleq:"¬ P ⊢ last Xs ≼⇧^* C" and throw:"e⇩₂ = THROW ClassCast"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂" by simp
    with wf eval_ref sconf wte have last:"last Cs = D" and notempty:"Cs ≠ []"
      by(auto dest!:eval_preserves_type Subobjs_nonempty split:if_split_asm)
    from disj have "C = D"
    proof(rule disjE)
      assume path_unique:"P ⊢ Path D to C unique"
      with last have "P ⊢ D ≼⇧^* C" 
        by(fastforce dest:Subobjs_subclass simp:path_unique_def)
      with notleq last eq show ?thesis by simp
    next
      assume ass:"P ⊢ C ≼⇧^* D ∧ 
                  (∀Cs. P ⊢ Path C to D via Cs  ⟶ Subobjs⇩_R P C Cs)"
      with "class" wf obtain Cs'' where path_via':"P ⊢ Path C to D via Cs''"
        by(auto dest:leq_implies_path)
      with path_via wf eq last have "Cs'' = [D]"
        by(fastforce dest:path_via_reverse)
      with ass path_via' have "Subobjs⇩_R P C [D]" by simp
      thus ?thesis by(fastforce dest:hd_SubobjsR)
    qed
    with last notin eq notempty show "ref (a,Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂"
      by(fastforce intro:last_in_set)
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "ref (a,Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (StaticDownCast E e s⇩₀ a Cs C Cs' s⇩₁ e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩" 
    and eval':"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a,Cs@[C]@Cs'),s⇩₁⟩"
    and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                      ⟹ ref(a,Cs@[C]@Cs') = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D"
    and disj:"P ⊢ Path D to C unique ∨ 
              (P ⊢ C ≼⇧^* D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩_R P C Cs))"
    by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩" 
      and path_via:"P ⊢ Path last Xs to C via Xs'"
      and ref:"e⇩₂ = ref (a',Xs@⇩_pXs')"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩₁ = s⇩₂"
      by simp
    with wf eval_ref sconf wte obtain C' where 
      last:"last(C#Cs') = D" and "Subobjs P C' (Cs@[C]@Cs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    hence "P ⊢ Path C to D via C#Cs'" 
      by(fastforce intro:Subobjs_Subobjs simp:path_via_def)
    with eq last path_via wf have "Xs' = [C] ∧ Cs' = [] ∧ C = D"
      apply clarsimp
      apply(split if_split_asm)
      by(simp,drule path_via_reverse,simp,simp)+
    with ref eq show "ref(a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by(fastforce simp:appendPath_def)
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
      and ref:"e⇩₂ = ref (a',Xs@[C])"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs@C#Xs' ∧ s⇩₁ = s⇩₂"
      by simp
    with wf eval_ref sconf wte obtain C' where 
      last:"last(C#Xs') = D" and subo:"Subobjs P C' (Cs@[C]@Cs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    from subo wf have notin:"C ∉ set Cs" by -(rule unique2,simp)
    from subo wf have "C ∉ set Cs'"  by -(rule unique1,simp,simp)
    with notin eq have "Cs = Xs ∧ Cs' = Xs'"
      by -(rule only_one_append,simp+)
    with eq ref show "ref(a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "ref (a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs a' 
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩" and notin:"C ∉ set Xs"
    from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩₁ = s⇩₂" 
      by simp
    with notin show "ref(a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by fastforce
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "ref (a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (StaticCastNull E e s⇩₀ s⇩₁ C e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ null = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
    from IH[OF eval_ref wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩" and "e⇩₂ = null"
    with IH[OF eval_null wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs a' 
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (StaticCastFail E e s⇩₀ a Cs s⇩₁ C e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and notleq:"¬ P ⊢ last Cs ≼⇧^* C" and notin:"C ∉ set Cs"
    and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ref (a, Cs) = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
      and path_via:"P ⊢ Path last Xs to C via Xs'"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂" by simp
    with path_via wf have "P ⊢ last Cs ≼⇧^* C" 
      by(auto dest:Subobjs_subclass simp:path_via_def)
    with notleq show "THROW ClassCast = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs = Xs@C#Xs' ∧ s⇩₁ = s⇩₂" by simp
    with notin show "THROW ClassCast = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "THROW ClassCast = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs a' 
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩"
      and throw:"e⇩₂ = THROW ClassCast"
    from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂"
      by simp
    with throw show "THROW ClassCast = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "THROW ClassCast = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed 
next
  case (StaticCastThrow E e s⇩₀ e' s⇩₁ C e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ ⦇C⦈e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                   ⟹ throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
    from IH[OF eval_ref wte sconf] show " throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e'' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e'',s⇩₂⟩"
      and throw:"e⇩₂ = throw e''"
    from IH[OF eval_throw wte sconf] throw show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (StaticUpDynCast E e s⇩₀ a Cs s⇩₁ C Cs' Ds e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and path_via:"P ⊢ Path last Cs to C via Cs'" 
    and path_unique:"P ⊢ Path last Cs to C unique"
    and Ds:"Ds = Cs@⇩_pCs'" and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ ref(a,Cs) = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
      and path_via':"P ⊢ Path last Xs to C via Xs'"
      and ref:"e⇩₂ = ref (a',Xs@⇩_pXs')"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂" by simp
    with wf eval_ref sconf wte have last:"last Cs = D"
      by(auto dest:eval_preserves_type split:if_split_asm)
    with path_unique path_via path_via' eq have "Xs' = Cs'"
      by(fastforce simp:path_via_def path_unique_def)
    with eq Ds ref show "ref (a, Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
      and ref:"e⇩₂ = ref (a',Xs@[C])"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ s⇩₁ = s⇩₂" by simp
    with wf eval_ref sconf wte obtain C' where 
      last:"last Cs = D" and "Subobjs P C' (Xs@C#Xs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    hence "Subobjs P C (C#Xs')" by(fastforce intro:Subobjs_Subobjs)
    with last eq have "P ⊢ Path C to D via C#Xs'" 
      by(simp add:path_via_def)
    with path_via wf last have "Xs' = [] ∧ Cs' = [C] ∧ C = D" 
      by(fastforce dest:path_via_reverse)
    with eq Ds ref show "ref (a, Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by (simp add:appendPath_def)
  next
    fix Xs Xs' D' S a' h l
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
      and h:"h a' = Some(D',S)" and path_via':"P ⊢ Path D' to C via Xs'"
      and path_unique':"P ⊢ Path D' to C unique" and s2:"s⇩₂ = (h,l)"
      and ref:"e⇩₂ = ref(a',Xs')"
    from IH[OF eval_ref wte sconf] s2 have eq:"a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂" by simp
    with wf eval_ref sconf wte h have "last Cs = D"
      and "Subobjs P D' Cs"
      by(auto dest:eval_preserves_type split:if_split_asm)
    with path_via wf have "P ⊢ Path D' to C via Cs@⇩_pCs'"
      by(fastforce intro:Subobjs_appendPath appendPath_last[THEN sym] 
                   dest:Subobjs_nonempty simp:path_via_def)
    with path_via' path_unique' Ds have "Xs' = Ds"
      by(fastforce simp:path_via_def path_unique_def)
    with eq ref show "ref (a, Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "ref (a, Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs D' S a' h l
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
      and not_unique:"¬ P ⊢ Path last Xs to C unique" and s2:"s⇩₂ = (h,l)"
    from IH[OF eval_ref wte sconf] s2 have eq:"a = a' ∧ Cs = Xs ∧ s⇩₁ = s⇩₂" by simp
    with path_unique not_unique show "ref (a, Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "ref (a, Ds) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (StaticDownDynCast E e s⇩₀ a Cs C Cs' s⇩₁ e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ ref(a,Cs@[C]@Cs') = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩" 
      and path_via:"P ⊢ Path last Xs to C via Xs'"
      and ref:"e⇩₂ = ref (a',Xs@⇩_pXs')"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩₁ = s⇩₂"
      by simp
    with wf eval_ref sconf wte obtain C' where 
      last:"last(C#Cs') = D" and "Subobjs P C' (Cs@[C]@Cs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    hence "P ⊢ Path C to D via C#Cs'" 
      by(fastforce intro:Subobjs_Subobjs simp:path_via_def)
    with eq last path_via wf have "Xs' = [C] ∧ Cs' = [] ∧ C = D"
      apply clarsimp
      apply(split if_split_asm)
      by(simp,drule path_via_reverse,simp,simp)+
    with ref eq show "ref(a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by(fastforce simp:appendPath_def)
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
      and ref:"e⇩₂ = ref (a',Xs@[C])"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs@[C]@Cs' = Xs@C#Xs' ∧ s⇩₁ = s⇩₂"
      by simp
    with wf eval_ref sconf wte obtain C' where 
      last:"last(C#Xs') = D" and subo:"Subobjs P C' (Cs@[C]@Cs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    from subo wf have notin:"C ∉ set Cs" by -(rule unique2,simp)
    from subo wf have "C ∉ set Cs'"  by -(rule unique1,simp,simp)
    with notin eq have "Cs = Xs ∧ Cs' = Xs'"
      by -(rule only_one_append,simp+)
    with eq ref show "ref(a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' D' S a' h l
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
      and h:"h a' = Some(D',S)" and path_via:"P ⊢ Path D' to C via Xs'"
      and path_unique:"P ⊢ Path D' to C unique" and s2:"s⇩₂ = (h,l)"
      and ref:"e⇩₂ = ref(a',Xs')"
    from IH[OF eval_ref wte sconf] s2 have eq:"a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩₁ = s⇩₂"
      by simp
    with wf eval_ref sconf wte h have "Subobjs P D' (Cs@[C]@Cs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    hence "Subobjs P D' (Cs@[C])" by(fastforce intro:appendSubobj)
    with path_via path_unique have "Xs' = Cs@[C]" 
      by(fastforce simp:path_via_def path_unique_def)
    with eq ref show "ref(a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "ref (a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs D' S a' h l
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
      and notin:"C ∉ set Xs" and s2:"s⇩₂ = (h,l)"
    from IH[OF eval_ref wte sconf] s2 have "a = a' ∧ Cs@[C]@Cs' = Xs ∧ s⇩₁ = s⇩₂"
      by simp
    with notin show "ref (a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by fastforce
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "ref (a,Cs@[C]) = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (DynCast E e s⇩₀ a Cs h l D S C Cs' e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and path_via:"P ⊢ Path D to C via Cs'" and path_unique:"P ⊢ Path D to C unique"
    and h:"h a = Some(D,S)" and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ ref(a,Cs) = e⇩₂ ∧ (h,l) = s⇩₂" by fact+
  from wt obtain D' where wte:"P,E ⊢ e :: Class D'" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩"
      and path_via':"P ⊢ Path last Xs to C via Xs'"
      and ref:"e⇩₂ = ref (a',Xs@⇩_pXs')"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ (h,l) = s⇩₂" by simp
    with wf eval_ref sconf wte h have "last Cs = D'"
      and "Subobjs P D Cs"
      by(auto dest:eval_preserves_type split:if_split_asm)
    with path_via' wf eq have "P ⊢ Path D to C via Xs@⇩_pXs'"
      by(fastforce intro:Subobjs_appendPath appendPath_last[THEN sym] 
                   dest:Subobjs_nonempty simp:path_via_def)
    with path_via path_unique have "Cs' = Xs@⇩_pXs'"
      by(fastforce simp:path_via_def path_unique_def)
    with ref eq show "ref(a,Cs') = e⇩₂ ∧ (h, l) = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
      and ref:"e⇩₂ = ref (a',Xs@[C])"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ (h,l) = s⇩₂"
      by simp
    with wf eval_ref sconf wte h have "Subobjs P D (Xs@[C]@Xs')"
      by(auto dest:eval_preserves_type split:if_split_asm)
    hence "Subobjs P D (Xs@[C])" by(fastforce intro:appendSubobj)
    with path_via path_unique have "Cs' = Xs@[C]" 
      by(fastforce simp:path_via_def path_unique_def)
    with eq ref show "ref(a,Cs') = e⇩₂ ∧ (h, l) = s⇩₂" by simp
  next
    fix Xs Xs' D'' S' a' h' l'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
      and h':"h' a' = Some(D'',S')" and path_via':"P ⊢ Path D'' to C via Xs'"
      and s2:"s⇩₂ = (h',l')" and ref:"e⇩₂ = ref(a',Xs')"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ h = h' ∧ l = l'"
      by simp
    with h h' path_via path_via' path_unique s2 ref
    show "ref(a,Cs') = e⇩₂ ∧ (h,l) = s⇩₂"
      by(fastforce simp:path_via_def path_unique_def)
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "ref(a,Cs') = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    fix Xs D'' S' a' h' l'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
      and h':"h' a' = Some(D'',S')" and not_unique:"¬ P ⊢ Path D'' to C unique"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ h = h' ∧ l = l'"
      by simp
    with h h' path_unique not_unique show "ref(a,Cs') = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "ref (a,Cs') = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  qed
next
  case (DynCastNull E e s⇩₀ s⇩₁ C e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ null = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
    from IH[OF eval_ref wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' D' S a' h l
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩"
    from IH[OF eval_ref wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩" and "e⇩₂ = null"
    with IH[OF eval_null wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs D' S a' h l
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h,l)⟩" and s2:"s⇩₂ = (h,l)"
    from IH[OF eval_ref wte sconf] s2 show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "null = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (DynCastFail E e s⇩₀ a Cs h l D S C e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and h:"h a = Some(D,S)" and not_unique1:"¬ P ⊢ Path D to C unique"
    and not_unique2:"¬ P ⊢ Path last Cs to C unique" and notin:"C ∉ set Cs"
    and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                   ⟹ ref (a, Cs) = e⇩₂ ∧ (h,l) = s⇩₂" by fact+
  from wt obtain D' where wte:"P,E ⊢ e :: Class D'" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⇩₂⟩"
      and path_unique:"P ⊢ Path last Xs to C unique"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs ∧ (h,l) = s⇩₂" by simp
    with path_unique not_unique2 show "null = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] have eq:"a = a' ∧ Cs = Xs@C#Xs' ∧ (h,l) = s⇩₂"
      by simp
    with notin show "null = e⇩₂ ∧ (h,l) = s⇩₂" by fastforce
  next
    fix Xs Xs' D'' S' a' h' l'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
      and h':"h' a' = Some(D'',S')" and path_unique:"P ⊢ Path D'' to C unique"
    from IH[OF eval_ref wte sconf] have "a = a' ∧ Cs = Xs ∧ h = h' ∧ l = l'"
      by simp
    with h h' not_unique1 path_unique show "null = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "null = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    fix Xs D'' S' a' h' l'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
      and null:"e⇩₂ = null" and s2:"s⇩₂ = (h',l')"
    from IH[OF eval_ref wte sconf] null s2 show "null = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "null = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  qed
next
  case (DynCastThrow E e s⇩₀ e' s⇩₁ C e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ Cast C e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                   ⟹ throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain D where wte:"P,E ⊢ e :: Class D" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a',Xs),s⇩₂⟩" 
    from IH[OF eval_ref wte sconf] show " throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' a'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs@C#Xs'),s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs Xs' D'' S' a' h' l'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix Xs D'' S' a' h' l'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),(h',l')⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e'' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e'',s⇩₂⟩"
      and throw:"e⇩₂ = throw e''"
    from IH[OF eval_throw wte sconf] throw show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case Val thus ?case by(auto elim: eval_cases)
next
  case (BinOp E e⇩₁ s⇩₀ v⇩₁ s⇩₁ e⇩₂ v⇩₂ s⇩₂ bop v e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨e⇩₁ «bop» e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    and binop:"binop (bop, v⇩₁, v⇩₂) = Some v"
    and wt:"P,E ⊢ e⇩₁ «bop» e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ Val v⇩₁ = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₂ :: T; P,E ⊢ s⇩₁ √⟧
                     ⟹ Val v⇩₂ = ei ∧ s⇩₂ = si" by fact+
  from wt obtain T⇩₁ T⇩₂ where wte1:"P,E ⊢ e⇩₁ :: T⇩₁" and wte2:"P,E ⊢ e⇩₂ :: T⇩₂"
    by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s w w⇩₁ w⇩₂
    assume eval_val1:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w⇩₁,s⟩"
      and eval_val2:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val w⇩₂,s⇩₂'⟩"
      and binop':"binop(bop,w⇩₁,w⇩₂) = Some w" and e2':"e⇩₂' = Val w"
    from IH1[OF eval_val1 wte1 sconf] have w1:"v⇩₁ = w⇩₁" and s:"s = s⇩₁" by simp_all
    with wf eval_val1 wte1 sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val2[simplified s] wte2 this] have "v⇩₂ = w⇩₂" and s2:"s⇩₂ = s⇩₂'"
      by simp_all
    with w1 binop binop' have "w = v" by simp
    with e2' s2 show "Val v = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix e assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw e,s⇩₂'⟩"
    from IH1[OF eval_throw wte1 sconf] show "Val v = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix e s w 
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      and eval_throw:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨throw e,s⇩₂'⟩"
    from IH1[OF eval_val wte1 sconf] have s:"s = s⇩₁" by simp_all
    with wf eval_val wte1 sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified s] wte2 this] show "Val v = e⇩₂' ∧ s⇩₂ = s⇩₂'"
      by simp
  qed
next
  case (BinOpThrow1 E e⇩₁ s⇩₀ e s⇩₁ bop e⇩₂ e⇩₂' s⇩₂ T)
   have eval:"P,E ⊢ ⟨e⇩₁ «bop» e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂⟩"
     and wt:"P,E ⊢ e⇩₁ «bop» e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
     and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ throw e = ei ∧ s⇩₁ = si" by fact+
   from wt obtain T⇩₁ T⇩₂ where wte1:"P,E ⊢ e⇩₁ :: T⇩₁" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s w w⇩₁ w⇩₂
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w⇩₁,s⟩"
    from IH[OF eval_val wte1 sconf] show "throw e = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e' 
    assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩" and throw:"e⇩₂' = throw e'"
    from IH[OF eval_throw wte1 sconf] throw show "throw e = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix e s w 
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
    from IH[OF eval_val wte1 sconf] show "throw e = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (BinOpThrow2 E e⇩₁ s⇩₀ v⇩₁ s⇩₁ e⇩₂ e s⇩₂ bop e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨e⇩₁ «bop» e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    and wt:"P,E ⊢ e⇩₁ «bop» e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ Val v⇩₁ = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₂ :: T; P,E ⊢ s⇩₁ √⟧
                    ⟹ throw e = ei ∧ s⇩₂ = si" by fact+
  from wt obtain T⇩₁ T⇩₂ where wte1:"P,E ⊢ e⇩₁ :: T⇩₁" and wte2:"P,E ⊢ e⇩₂ :: T⇩₂"
    by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s w w⇩₁ w⇩₂
    assume eval_val1:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w⇩₁,s⟩"
      and eval_val2:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val w⇩₂,s⇩₂'⟩"
    from IH1[OF eval_val1 wte1 sconf] have s:"s = s⇩₁" by simp_all
    with wf eval_val1 wte1 sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val2[simplified s] wte2 this] show "throw e = e⇩₂' ∧ s⇩₂ = s⇩₂'"
      by simp
  next
    fix e' 
    assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂'⟩"
    from IH1[OF eval_throw wte1 sconf] show "throw e = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix e' s w 
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      and eval_throw:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨throw e',s⇩₂'⟩"
      and throw:"e⇩₂' = throw e'"
    from IH1[OF eval_val wte1 sconf] have s:"s = s⇩₁" by simp_all
    with wf eval_val wte1 sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified s] wte2 this] throw
    show "throw e = e⇩₂' ∧ s⇩₂ = s⇩₂'"
      by simp
  qed
next
  case Var thus ?case by(auto elim: eval_cases)    
next
  case (LAss E e s⇩₀ v h l V T v' l' e⇩₂ s⇩₂ T')
  have eval:"P,E ⊢ ⟨V:=e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and env:"E V = Some T" and casts:"P ⊢ T casts v to v'" and l':"l' = l(V ↦ v')"
    and wt:"P,E ⊢ V:=e :: T'" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ Val v = e⇩₂ ∧ (h,l) = s⇩₂" by fact+
  from wt env obtain T'' where wte:"P,E ⊢ e :: T''" and leq:"P ⊢ T'' ≤ T" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix U h' l'' w w'
    assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,(h',l'')⟩" and env':"E V = Some U"
      and casts':"P ⊢ U casts w to w'" and e2:"e⇩₂ = Val w'" 
      and s2:"s⇩₂ = (h',l''(V ↦ w'))"
    from env env' have UeqT:"U = T" by simp
    from IH[OF eval_val wte sconf] have eq:"v = w ∧ h = h' ∧ l = l''" by simp
    from sconf env have "is_type P T"
      by(clarsimp simp:sconf_def envconf_def)
    with casts casts' eq UeqT wte leq eval_val sconf wf have "v' = w'"
      by(auto intro:casts_casts_eq_result)
    with e2 s2 l' eq show "Val v' = e⇩₂ ∧ (h, l') = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "Val v' = e⇩₂ ∧ (h, l') = s⇩₂" by simp
  qed
next
  case (LAssThrow E e s⇩₀ e' s⇩₁ V e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨V:=e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ V:=e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain T'' where wte:"P,E ⊢ e :: T''" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix U h' l'' w w'
    assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,(h',l'')⟩"
    from IH[OF eval_val wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex 
    assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
    from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (FAcc E e s⇩₀ a Cs' h l D S Ds Cs fs F v e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨e∙F{Cs},s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and eval':"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref (a, Cs'),(h,l)⟩"
    and h:"h a = Some(D,S)" and Ds:"Ds = Cs'@⇩_pCs"
    and S:"(Ds,fs) ∈ S" and fs:"fs F = Some v"
    and wt:"P,E ⊢ e∙F{Cs} :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ ref (a, Cs') = e⇩₂ ∧ (h,l) = s⇩₂" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
  from eval_preserves_sconf[OF wf eval' wte sconf] h have oconf:"P,h ⊢ (D,S) √"
    by(simp add:sconf_def hconf_def)
  from eval show ?case
  proof(rule eval_cases)
    fix Xs' D' S' a' fs' h' l' v'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs'),(h',l')⟩"
    and h':"h' a' = Some(D',S')" and S':"(Xs'@⇩_pCs,fs') ∈ S'"
    and fs':"fs' F = Some v'" and e2:"e⇩₂ = Val v'" and s2:"s⇩₂ = (h',l')"
    from IH[OF eval_ref wte sconf] h h'
    have eq:"a = a' ∧ Cs' = Xs' ∧ h = h' ∧ l = l' ∧ D = D' ∧ S = S'" by simp
    with oconf S S' Ds have "fs = fs'" by (auto simp:oconf_def)
    with fs fs' have "v = v'" by simp
    with e2 s2 eq show "Val v = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "Val v = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "Val v = e⇩₂ ∧ (h,l) = s⇩₂" by simp
  qed
next
  case (FAccNull E e s⇩₀ s⇩₁ F Cs e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨e∙F{Cs},s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ e∙F{Cs} :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ null = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs' D' S' a' fs' h' l' v'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs'),(h',l')⟩"
    from IH[OF eval_ref wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩" and e2:"e⇩₂ = THROW NullPointer"
    from IH[OF eval_null wte sconf] e2 show "THROW NullPointer = e⇩₂ ∧ s⇩₁ = s⇩₂" 
      by simp
  next
    fix e' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw e',s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (FAccThrow E e s⇩₀ e' s⇩₁ F Cs e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨e∙F{Cs},s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ e∙F{Cs} :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs' D' S' a' fs' h' l' v'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs'),(h',l')⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex 
    assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
    from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (FAss E e⇩₁ s⇩₀ a Cs' s⇩₁ e⇩₂ v h⇩₂ l⇩₂ D S F T Cs v' Ds fs fs' S' h⇩₂' e⇩₂' s⇩₂ T')
  have eval:"P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂⟩"
    and eval':"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ref(a,Cs'),s⇩₁⟩"
    and eval'':"P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨Val v,(h⇩₂,l⇩₂)⟩"
    and h2:"h⇩₂ a = Some(D, S)"
    and has_least:"P ⊢ last Cs' has least F:T via Cs"
    and casts:"P ⊢ T casts v to v'" and Ds:"Ds = Cs'@⇩_pCs"
    and S:"(Ds, fs) ∈ S" and fs':"fs' = fs(F ↦ v')"
    and S':"S' = S - {(Ds, fs)} ∪ {(Ds, fs')}"
    and h2':"h⇩₂' = h⇩₂(a ↦ (D, S'))"
    and wt:"P,E ⊢ e⇩₁∙F{Cs} := e⇩₂ :: T'" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ ref(a,Cs') = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₂ :: T; P,E ⊢ s⇩₁ √⟧
                    ⟹ Val v = ei ∧ (h⇩₂,l⇩₂) = si" by fact+
  from wt obtain C T'' where wte1:"P,E ⊢ e⇩₁ :: Class C" 
    and has_least':"P ⊢ C has least F:T' via Cs"
    and wte2:"P,E ⊢ e⇩₂ :: T''" and leq:"P ⊢ T'' ≤ T'"
    by auto
  from wf eval' wte1 sconf have "last Cs' = C"
    by(auto dest!:eval_preserves_type split:if_split_asm)
  with has_least has_least' have TeqT':"T = T'" by (fastforce intro:sees_field_fun)
  from eval show ?case
  proof(rule eval_cases)
    fix Xs D' S'' U a' fs'' h l s w w'
    assume eval_ref:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      and eval_val:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val w,(h,l)⟩"
      and h:"h a' = Some(D',S'')"
      and has_least'':"P ⊢ last Xs has least F:U via Cs"
      and casts':"P ⊢ U casts w to w'"
      and S'':"(Xs@⇩_pCs,fs'') ∈ S''" and e2':"e⇩₂' = Val w'"
      and s2:"s⇩₂ = (h(a'↦(D',insert (Xs@⇩_pCs,fs''(F ↦ w')) 
                                     (S''-{(Xs@⇩_pCs,fs'')}))),l)"
    from IH1[OF eval_ref wte1 sconf] have eq:"a = a' ∧ Cs' = Xs ∧ s⇩₁ = s" by simp
    with wf eval_ref wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF _ wte2 this] eval_val eq have eq':"v = w ∧ h = h⇩₂ ∧ l = l⇩₂" by auto
    from has_least'' eq has_least have UeqT:"U = T" by (fastforce intro:sees_field_fun)
    from has_least wf have "is_type P T" by(rule least_field_is_type)
    with casts casts' eq eq' UeqT TeqT' wte2 leq eval_val sconf' wf have v':"v' = w'"
      by(auto intro!:casts_casts_eq_result)
    from eval_preserves_sconf[OF wf eval'' wte2 sconf'] h2
    have oconf:"P,h⇩₂ ⊢ (D,S) √"
      by(simp add:sconf_def hconf_def)
    from eq eq' h2 h have "S = S''" by simp
    with oconf eq S S' S'' Ds have "fs = fs''" by (auto simp:oconf_def)
    with h2' h h2 eq eq' s2 S' Ds fs' v' e2' show "Val v' = e⇩₂' ∧ (h⇩₂',l⇩₂) = s⇩₂"
      by simp
  next
    fix s w assume eval_null:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨null,s⟩"
    from IH1[OF eval_null wte1 sconf] show "Val v' = e⇩₂' ∧ (h⇩₂',l⇩₂) = s⇩₂" by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩"
    from IH1[OF eval_throw wte1 sconf] show "Val v' = e⇩₂' ∧ (h⇩₂',l⇩₂) = s⇩₂" by simp
  next
    fix ex s w
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩" 
      and eval_throw:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨throw ex,s⇩₂⟩"
    from IH1[OF eval_val wte1 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_val wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified eq] wte2 this]
    show "Val v' = e⇩₂' ∧ (h⇩₂',l⇩₂) = s⇩₂" by simp
  qed
next
  case (FAssNull E e⇩₁ s⇩₀ s⇩₁ e⇩₂ v s⇩₂ F Cs e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    and wt:"P,E ⊢ e⇩₁∙F{Cs} := e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ null = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₂ :: T; P,E ⊢ s⇩₁ √⟧
                    ⟹ Val v = ei ∧ s⇩₂ = si" by fact+
  from wt obtain C T'' where wte1:"P,E ⊢ e⇩₁ :: Class C" 
    and wte2:"P,E ⊢ e⇩₂ :: T''" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs D' S'' U a' fs'' h l s w w'
    assume eval_ref:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
    from IH1[OF eval_ref wte1 sconf] show "THROW NullPointer = e⇩₂' ∧ s⇩₂ = s⇩₂'"
      by simp
  next
    fix s w 
    assume eval_null:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨null,s⟩"
      and eval_val:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val w,s⇩₂'⟩"
      and e2':"e⇩₂' = THROW NullPointer"
    from IH1[OF eval_null wte1 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_null wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val[simplified eq] wte2 this] e2'
    show "THROW NullPointer = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_throw wte1 sconf] show "THROW NullPointer = e⇩₂' ∧ s⇩₂ = s⇩₂'" 
      by simp
  next
    fix ex s w
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      and eval_throw:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_val wte1 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_val wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified eq] wte2 this] 
    show "THROW NullPointer = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  qed
next
  case (FAssThrow1 E e⇩₁ s⇩₀ e' s⇩₁ F Cs e⇩₂ e⇩₂' s⇩₂ T)
  have eval:"P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂⟩" 
    and wt:"P,E ⊢ e⇩₁∙F{Cs} := e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ throw e' = ei ∧ s⇩₁ = si" by fact+
  from wt obtain C T'' where wte1:"P,E ⊢ e⇩₁ :: Class C" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs D' S'' U a' fs'' h l s w w'
    assume eval_ref:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
    from IH[OF eval_ref wte1 sconf] show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix s w 
    assume eval_null:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨null,s⟩"
    from IH[OF eval_null wte1 sconf] show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex
    assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2':"e⇩₂' = throw ex"
    from IH[OF eval_throw wte1 sconf] e2' show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex s w assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
    from IH[OF eval_val wte1 sconf] show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (FAssThrow2 E e⇩₁ s⇩₀ v s⇩₁ e⇩₂ e' s⇩₂ F Cs e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨e⇩₁∙F{Cs} := e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩" 
    and wt:"P,E ⊢ e⇩₁∙F{Cs} := e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ Val v = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₂ :: T; P,E ⊢ s⇩₁ √⟧
                    ⟹ throw e' = ei ∧ s⇩₂ = si" by fact+
  from wt obtain C T'' where wte1:"P,E ⊢ e⇩₁ :: Class C" 
    and wte2:"P,E ⊢ e⇩₂ :: T''" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix Xs D' S'' U a' fs'' h l s w w'
    assume eval_ref:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      and eval_val:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val w,(h,l)⟩"
    from IH1[OF eval_ref wte1 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_ref wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val[simplified eq] wte2 this] show "throw e' = e⇩₂' ∧ s⇩₂ = s⇩₂'"
      by simp
  next
    fix s w 
    assume eval_null:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨null,s⟩"
      and eval_val:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨Val w,s⇩₂'⟩"
    from IH1[OF eval_null wte1 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_null wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val[simplified eq] wte2 this] show "throw e' = e⇩₂' ∧ s⇩₂ = s⇩₂'"
      by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_throw wte1 sconf] show "throw e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix ex s w
    assume eval_val:"P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      and eval_throw:"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨throw ex,s⇩₂'⟩" and e2':"e⇩₂' = throw ex"
    from IH1[OF eval_val wte1 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_val wte1 sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified eq] wte2 this] e2' 
    show "throw e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  qed
next
  case (CallObjThrow E e s⇩₀ e' s⇩₁ Copt M es e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ Call e Copt M es :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by(cases Copt)auto
  show ?case
  proof(cases Copt)
    assume "Copt = None"
    with eval have "P,E ⊢ ⟨e∙M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩" by simp
    thus ?thesis
    proof(rule eval_cases)
      fix ex
      assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
      from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    next
      fix es' ex' s w ws assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      from IH[OF eval_val wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    next
      fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
          s ws ws'
      assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    next
      fix s ws
      assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
      from IH[OF eval_null wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    qed
  next
    fix C' assume "Copt = Some C'"
    with eval have "P,E ⊢ ⟨e∙(C'::)M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩" by simp
    thus ?thesis
    proof(rule eval_cases)
      fix ex
      assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
      from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    next
      fix es' ex' s w ws assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      from IH[OF eval_val wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    next
      fix C'' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
          s ws ws'
      assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    next
      fix s ws
      assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
      from IH[OF eval_null wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
    qed
  qed
next
  case (CallParamsThrow E e s⇩₀ v s⇩₁ es vs ex es' s⇩₂ Copt M e⇩₂ s⇩₂' T)
  have eval:"P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩"
    and wt:"P,E ⊢ Call e Copt M es :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ Val v = ei ∧ s⇩₁ = si"
    and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩₁ √⟧
                      ⟹ map Val vs @ throw ex # es' = esi ∧ s⇩₂ = si" by fact+
  from wt obtain C Ts where wte:"P,E ⊢ e :: Class C" and wtes:"P,E ⊢ es [::] Ts" 
    by(cases Copt)auto
  show ?case
  proof(cases Copt)
    assume "Copt = None"
    with eval have "P,E ⊢ ⟨e∙M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩" by simp
    thus ?thesis
    proof(rule eval_cases)
      fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex',s⇩₂'⟩"
      from IH1[OF eval_throw wte sconf] show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
    next
      fix es'' ex' s w ws
      assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩" 
        and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩₂'⟩"
        and e2:"e⇩₂ = throw ex'"
      from IH1[OF eval_val wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_throw[simplified eq] wtes this] e2
      have "vs = ws ∧ ex = ex' ∧ es' = es'' ∧ s⇩₂ = s⇩₂'"
        by(fastforce dest:map_Val_throw_eq)
      with e2 show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
    next
      fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
          s ws ws'
      assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
        and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
      from IH1[OF eval_ref wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_vals[simplified eq] wtes this]
      show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'"
        by(fastforce dest:sym[THEN map_Val_throw_False])
    next
      fix s ws
      assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
        and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩₂'⟩"
        and e2:"e⇩₂ = THROW NullPointer"
      from IH1[OF eval_null wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_vals[simplified eq] wtes this] 
      show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'"
        by(fastforce dest:sym[THEN map_Val_throw_False])
    qed
  next
    fix C' assume "Copt = Some C'"
    with eval have "P,E ⊢ ⟨e∙(C'::)M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩" by simp
    thus ?thesis
    proof(rule eval_cases)
      fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex',s⇩₂'⟩"
      from IH1[OF eval_throw wte sconf] show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
    next
      fix es'' ex' s w ws
      assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩" 
        and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩₂'⟩"
        and e2:"e⇩₂ = throw ex'"
      from IH1[OF eval_val wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_throw[simplified eq] wtes this] e2
      have "vs = ws ∧ ex = ex' ∧ es' = es'' ∧ s⇩₂ = s⇩₂'"
        by(fastforce dest:map_Val_throw_eq)
      with e2 show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
    next
      fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
          s ws ws'
      assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
        and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
      from IH1[OF eval_ref wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_vals[simplified eq] wtes this]
      show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'"
        by(fastforce dest:sym[THEN map_Val_throw_False])
    next
      fix s ws
      assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
        and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩₂'⟩"
        and e2:"e⇩₂ = THROW NullPointer"
      from IH1[OF eval_null wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_vals[simplified eq] wtes this] 
      show "throw ex = e⇩₂ ∧ s⇩₂ = s⇩₂'"
        by(fastforce dest:sym[THEN map_Val_throw_False])
    qed
  qed
next
  case (Call E e s⇩₀ a Cs s⇩₁ es vs h⇩₂ l⇩₂ C S M Ts' T' pns' body' Ds Ts T pns
             body Cs' vs' l⇩₂' new_body e' h⇩₃ l⇩₃ e⇩₂ s⇩₂ T'')
  have eval:"P,E ⊢ ⟨e∙M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and eval':"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a,Cs),s⇩₁⟩"
    and eval'':"P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨map Val vs,(h⇩₂,l⇩₂)⟩" and h2:"h⇩₂ a = Some(C,S)"
    and has_least:"P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds"
    and selects:"P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'"
    and length:"length vs = length pns" and Casts:"P ⊢ Ts Casts vs to vs'"
    and l2':"l⇩₂' = [this ↦ Ref (a, Cs'), pns [↦] vs']"
    and new_body:"new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body)"
    and eval_body:"P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ 
                                            ⟨new_body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨e',(h⇩₃,l⇩₃)⟩"
    and wt:"P,E ⊢ e∙M(es) :: T''" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ ref (a,Cs) = ei ∧ s⇩₁ = si"
    and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩₁ √⟧
                      ⟹ map Val vs = esi ∧ (h⇩₂,l⇩₂) = si"
    and IH3:"⋀ei si T. 
    ⟦P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨new_body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨ei,si⟩;
     P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ new_body :: T;
     P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ (h⇩₂,l⇩₂') √⟧
  ⟹ e' = ei ∧ (h⇩₃, l⇩₃) = si" by fact+
  from wt obtain D Ss Ss' m Cs'' where wte:"P,E ⊢ e :: Class D" 
    and has_least':"P ⊢ D has least M = (Ss,T'',m) via Cs''"
    and wtes:"P,E ⊢ es [::] Ss'" and subs:"P ⊢ Ss' [≤] Ss" by auto
  from eval_preserves_type[OF wf eval' sconf wte]
  have last:"last Cs = D" by (auto split:if_split_asm)
  with has_least has_least' wf
  have eq:"Ts' = Ss ∧ T' = T'' ∧ (pns',body') = m ∧ Ds = Cs''"
    by(fastforce dest:wf_sees_method_fun)
  from wf selects have param_type:"∀T ∈ set Ts. is_type P T" 
    and return_type:"is_type P T" and TnotNT:"T ≠ NT"
    by(auto dest:select_method_wf_mdecl simp:wf_mdecl_def)
  from selects wf have subo:"Subobjs P C Cs'"
    by(induct rule:SelectMethodDef.induct,
       auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def 
                 MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
  with wf have "class":"is_class P (last Cs')" by(auto intro!:Subobj_last_isClass)
  from eval'' have hext:"hp s⇩₁ ⊴ h⇩₂" by (cases s⇩₁,auto intro: evals_hext)
  from wf eval' sconf wte last have "P,E,(hp s⇩₁) ⊢ ref(a,Cs) :⇘_NT⇙ Class(last Cs)"
    by -(rule eval_preserves_type,simp_all)
  with hext have "P,E,h⇩₂ ⊢ ref(a,Cs) :⇘_NT⇙ Class(last Cs)"
    by(auto intro:WTrt_hext_mono dest:hext_objD split:if_split_asm)
  with h2 have "Subobjs P C Cs" by (auto split:if_split_asm)
  hence "P ⊢ Path C to (last Cs) via Cs"
    by (auto simp:path_via_def split:if_split_asm)
  with selects has_least wf have param_types:"Ts' = Ts ∧ P ⊢ T ≤ T'"
    by -(rule select_least_methods_subtypes,simp_all)
  from wf selects have wt_body:"P,[this↦Class(last Cs'),pns[↦]Ts] ⊢ body :: T"
    and this_not_pns:"this ∉ set pns" and length:"length pns = length Ts"
    and dist:"distinct pns"
    by(auto dest!:select_method_wf_mdecl simp:wf_mdecl_def)
  have "P,[this↦Class(last Cs'),pns[↦]Ts] ⊢ new_body :: T'"
  proof(cases "∃C. T' = Class C")
    case False with wt_body new_body param_types show ?thesis by(cases T') auto
  next
    case True
    then obtain D' where T':"T' = Class D'" by auto
    with wf has_least have "class":"is_class P D'"
      by(fastforce dest:has_least_wf_mdecl simp:wf_mdecl_def)
    with wf T' TnotNT param_types obtain D'' where T:"T = Class D''"
      by(fastforce dest:widen_Class)
    with wf return_type T' param_types have "P ⊢ Path D'' to D' unique"
      by(simp add:Class_widen_Class)
    with wt_body "class" T T' new_body show ?thesis by auto
  qed
  hence wt_new_body:"P,E(this↦Class(last Cs'),pns[↦]Ts) ⊢ new_body :: T'"
    by(fastforce intro:wt_env_mono)
  from eval show ?case
  proof(rule eval_cases)
    fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex',s⇩₂⟩"
    from IH1[OF eval_throw wte sconf] show "e' = e⇩₂ ∧ (h⇩₃, l⇩₂) = s⇩₂" by simp
  next
    fix es'' ex' s w ws
    assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩" 
      and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩₂⟩"
    from IH1[OF eval_val wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF evals_throw[simplified eq] wtes this] show "e' = e⇩₂ ∧ (h⇩₃, l⇩₂) = s⇩₂"
      by(fastforce dest:map_Val_throw_False)
  next
    fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' s ws ws'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
      and h:"h a' = Some(C',S')" 
      and has_least'':"P ⊢ last Xs has least M = (Us',U',pns''',body''') via Ds'"
      and selects':"P ⊢ (C',Xs@⇩_pDs') selects M = (Us,U,pns'',body'') via Xs'"
      and length':"length ws = length pns''" and Casts':"P ⊢ Us Casts ws to ws'"
      and eval_body':"P,E(this ↦ Class (last Xs'), pns'' [↦] Us) ⊢ 
      ⟨case U' of Class D ⇒ ⦇D⦈body'' | _ ⇒ body'',
        (h,[this ↦ Ref(a',Xs'), pns'' [↦] ws'])⟩ ⇒ ⟨e⇩₂,(h',l')⟩"
      and s2:"s⇩₂ = (h',l)"
    from IH1[OF eval_ref wte sconf] have eq1:"a = a' ∧ Cs = Xs" and s:"s = s⇩₁" 
      by simp_all
    with has_least has_least'' wf have eq2:"T' = U' ∧ Ts' = Us' ∧ Ds = Ds'"
      by(fastforce dest:wf_sees_method_fun)
    from s wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF evals_vals[simplified s] wtes this]
    have eq3:"vs = ws ∧ h⇩₂ = h ∧ l⇩₂ = l"
      by(fastforce elim:map_injective simp:inj_on_def)
    with eq1 h2 h have eq4:"C = C' ∧ S = S'" by simp
    with eq1 eq2 selects selects' wf
    have eq5:"Ts = Us ∧ T = U ∧ pns'' = pns ∧ body'' = body ∧ Cs' = Xs'"
      by simp(drule_tac mthd'="(Us,U,pns'',body'')" in wf_select_method_fun,auto)
    with subs eq param_types have "P ⊢ Ss' [≤] Us" by simp
    with wf Casts Casts' param_type wtes evals_vals sconf' s eq eq2 eq3 eq5
    have eq6:"vs' = ws'"
      by(fastforce intro:Casts_Casts_eq_result)
    with eval_body' l2' eq1 eq2 eq3 eq5 new_body  
    have eval_body'':"P,E(this ↦ Class(last Cs'), pns [↦] Ts) ⊢ 
                           ⟨new_body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨e⇩₂,(h',l')⟩"
      by fastforce
    from wf evals_vals wtes sconf' s eq3 have sconf'':"P,E ⊢ (h⇩₂,l⇩₂) √"
      by(fastforce intro:evals_preserves_sconf)
    have "P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ (h⇩₂,l⇩₂') √"
    proof(auto simp:sconf_def)
      from sconf'' show "P ⊢ h⇩₂ √" by(simp add:sconf_def)
    next
      { fix V v assume map:"[this ↦ Ref (a,Cs'), pns [↦] vs'] V = Some v"
        have "∃T. (E(this ↦ Class (last Cs'), pns [↦] Ts)) V = Some T ∧ 
                   P,h⇩₂ ⊢ v :≤ T"
        proof(cases "V ∈ set (this#pns)")
          case False with map show ?thesis by simp
        next
          case True
          hence "V = this ∨ V ∈ set pns" by simp
          thus ?thesis
          proof(rule disjE)
            assume V:"V = this"
            with map this_not_pns have "v = Ref(a,Cs')" by simp
            with V h2 subo this_not_pns have 
              "(E(this ↦ Class (last Cs'),pns [↦] Ts)) V = Some(Class (last Cs'))"
              and "P,h⇩₂ ⊢ v :≤ Class (last Cs')" by simp_all
            thus ?thesis by simp
          next
            assume "V ∈ set pns"
            then obtain i where V:"V = pns!i" and length_i:"i < length pns"
              by(auto simp:in_set_conv_nth)
            from Casts have "length Ts = length vs'"
              by(induct rule:Casts_to.induct,auto)
            with length have "length pns = length vs'" by simp
            with map dist V length_i have v:"v = vs'!i" by(fastforce dest:maps_nth)
            from length dist length_i
            have env:"(E(this ↦ Class (last Cs'))(pns [↦] Ts)) (pns!i) = Some(Ts!i)"
              by(rule_tac E="E(this ↦ Class (last Cs'))" in nth_maps,simp_all)
            from wf Casts wtes subs eq param_types eval'' sconf'
            have "∀i < length Ts. P,h⇩₂ ⊢ vs'!i :≤ Ts!i"
              by simp(rule Casts_conf,auto)
            with length_i length env V v show ?thesis by simp
          qed
        qed }
      thus "P,h⇩₂ ⊢ l⇩₂' (:≤)⇩_w E(this ↦ Class (last Cs'), pns [↦] Ts)"
        using l2' by(simp add:lconf_def)
    next
      { fix V Tx assume env:"(E(this ↦ Class (last Cs'), pns [↦] Ts)) V = Some Tx"
        have "is_type P Tx"
        proof(cases "V ∈ set (this#pns)")
          case False
          with env sconf'' show ?thesis
            by(clarsimp simp:sconf_def envconf_def)
        next
          case True
          hence "V = this ∨ V ∈ set pns" by simp
          thus ?thesis
          proof(rule disjE)
            assume "V = this"
            with env this_not_pns have "Tx = Class(last Cs')" by simp
            with "class" show ?thesis by simp
          next
            assume "V ∈ set pns"
            then obtain i where V:"V = pns!i" and length_i:"i < length pns"
              by(auto simp:in_set_conv_nth)
            with dist length env have "Tx = Ts!i" by(fastforce dest:maps_nth)
            with length_i length have "Tx ∈ set Ts"
              by(fastforce simp:in_set_conv_nth)
            with param_type show ?thesis by simp
          qed
        qed }
      thus "P ⊢ E(this ↦ Class (last Cs'), pns [↦] Ts) √" by (simp add:envconf_def)
    qed
    from IH3[OF eval_body'' wt_new_body this] have "e' = e⇩₂ ∧ (h⇩₃, l⇩₃) = (h',l')" .
    with eq3 s2 show "e' = e⇩₂ ∧ (h⇩₃,l⇩₂) = s⇩₂" by simp
  next
    fix s ws
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
    from IH1[OF eval_null wte sconf] show "e' = e⇩₂ ∧ (h⇩₃,l⇩₂) = s⇩₂" by simp
  qed
next
  case (StaticCall E e s⇩₀ a Cs s⇩₁ es vs h⇩₂ l⇩₂ C Cs'' M Ts T pns body  Cs'
                   Ds vs' l⇩₂' e' h⇩₃ l⇩₃ e⇩₂ s⇩₂ T')
  have eval:"P,E ⊢ ⟨e∙(C::)M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and eval':"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a,Cs),s⇩₁⟩"
    and eval'':"P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨map Val vs,(h⇩₂, l⇩₂)⟩"
    and path_unique:"P ⊢ Path last Cs to C unique" 
    and path_via:"P ⊢ Path last Cs to C via Cs''"
    and has_least:"P ⊢ C has least M = (Ts,T,pns,body) via Cs'"
    and Ds:"Ds = (Cs@⇩_pCs'')@⇩_pCs'" and length:"length vs = length pns"
    and Casts:"P ⊢ Ts Casts vs to vs'"
    and l2':"l⇩₂' = [this ↦ Ref (a, Ds), pns [↦] vs']"
    and eval_body:"P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ 
                                             ⟨body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨e',(h⇩₃,l⇩₃)⟩"
    and wt:"P,E ⊢ e∙(C::)M(es) :: T'" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ ref (a,Cs) = ei ∧ s⇩₁ = si"
    and IH2:"⋀esi si Ts. 
             ⟦P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩₁ √⟧
                    ⟹ map Val vs = esi ∧ (h⇩₂,l⇩₂) = si"
    and IH3:"⋀ei si T.
   ⟦P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ ⟨body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨ei,si⟩;
    P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ body :: T;
    P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ (h⇩₂,l⇩₂') √⟧
                    ⟹ e' = ei ∧ (h⇩₃, l⇩₃) = si" by fact+
  from wt has_least wf obtain C' Ts' where wte:"P,E ⊢ e :: Class C'"
      and wtes:"P,E ⊢ es [::] Ts'" and subs:"P ⊢ Ts' [≤] Ts"
    by(auto dest:wf_sees_method_fun)
  from eval_preserves_type[OF wf eval' sconf wte]
  have last:"last Cs = C'" by (auto split:if_split_asm)
  from wf has_least have param_type:"∀T ∈ set Ts. is_type P T" 
    and return_type:"is_type P T" and TnotNT:"T ≠ NT"
    by(auto dest:has_least_wf_mdecl simp:wf_mdecl_def)
  from path_via have last':"last Cs'' = last(Cs@⇩_pCs'')"
    by(fastforce intro!:appendPath_last Subobjs_nonempty simp:path_via_def)
  from eval'' have hext:"hp s⇩₁ ⊴ h⇩₂" by (cases s⇩₁,auto intro: evals_hext)
  from wf eval' sconf wte last have "P,E,(hp s⇩₁) ⊢ ref(a,Cs) :⇘_NT⇙ Class(last Cs)"
    by -(rule eval_preserves_type,simp_all)
  with hext have "P,E,h⇩₂ ⊢ ref(a,Cs) :⇘_NT⇙ Class(last Cs)"
    by(auto intro:WTrt_hext_mono dest:hext_objD split:if_split_asm)
  then obtain D S where h2:"h⇩₂ a = Some(D,S)" and "Subobjs P D Cs"
    by (auto split:if_split_asm)
  with path_via wf have "Subobjs P D (Cs@⇩_pCs'')" and "last Cs'' = C"
    by(auto intro:Subobjs_appendPath simp:path_via_def)
  with has_least wf last' Ds have subo:"Subobjs P D Ds"
    by(fastforce intro:Subobjs_appendPath simp:LeastMethodDef_def MethodDefs_def)
  with wf have "class":"is_class P (last Ds)" by(auto intro!:Subobj_last_isClass)
  from has_least wf obtain D' where "Subobjs P D' Cs'"
    by(auto simp:LeastMethodDef_def MethodDefs_def)
  with Ds have last_Ds:"last Cs' = last Ds"
    by(fastforce intro!:appendPath_last Subobjs_nonempty)
  with wf has_least have "P,[this↦Class(last Ds),pns[↦]Ts] ⊢ body :: T"
    and this_not_pns:"this ∉ set pns" and length:"length pns = length Ts"
    and dist:"distinct pns"
    by(auto dest!:has_least_wf_mdecl simp:wf_mdecl_def)
  hence wt_body:"P,E(this↦Class(last Ds),pns[↦]Ts) ⊢ body :: T"
    by(fastforce intro:wt_env_mono)
  from eval show ?case
  proof(rule eval_cases)
    fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex',s⇩₂⟩"
    from IH1[OF eval_throw wte sconf] show "e' = e⇩₂ ∧ (h⇩₃, l⇩₂) = s⇩₂" by simp
  next
    fix es'' ex' s w ws
    assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩" 
      and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es'',s⇩₂⟩"
    from IH1[OF eval_val wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF evals_throw[simplified eq] wtes this] show "e' = e⇩₂ ∧ (h⇩₃, l⇩₂) = s⇩₂"
      by(fastforce dest:map_Val_throw_False)
  next
    fix Xs Xs' Xs'' U Us a' body' h h' l l' pns' s ws ws'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,(h,l)⟩"
      and path_unique':"P ⊢ Path last Xs to C unique"
      and path_via':"P ⊢ Path last Xs to C via Xs''"
      and has_least':"P ⊢ C has least M = (Us,U,pns',body') via Xs'"
      and length':"length ws = length pns'"
      and Casts':"P ⊢ Us Casts ws to ws'"
      and eval_body':"P,E(this ↦ Class(last((Xs@⇩_pXs'')@⇩_pXs')),pns' [↦] Us) ⊢ 
      ⟨body',(h,[this ↦ Ref(a',(Xs@⇩_pXs'')@⇩_pXs'),pns' [↦] ws'])⟩ ⇒ ⟨e⇩₂,(h',l')⟩"
      and s2:"s⇩₂ = (h',l)"
    from IH1[OF eval_ref wte sconf] have eq1:"a = a' ∧ Cs = Xs" and s:"s = s⇩₁" 
      by simp_all
    from has_least has_least' wf 
    have eq2:"T = U ∧ Ts = Us ∧ Cs' = Xs' ∧ pns = pns' ∧ body = body'"
      by(fastforce dest:wf_sees_method_fun)
    from s wf eval_ref wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF evals_vals[simplified s] wtes this]
    have eq3:"vs = ws ∧ h⇩₂ = h ∧ l⇩₂ = l"
      by(fastforce elim:map_injective simp:inj_on_def)
    from path_unique path_via path_via' eq1 have "Cs'' = Xs''" 
      by(fastforce simp:path_unique_def path_via_def)
    with Ds eq1 eq2 have Ds':"Ds = (Xs@⇩_pXs'')@⇩_pXs'" by simp
    from wf Casts Casts' param_type wtes subs evals_vals sconf' s eq2 eq3
    have eq4:"vs' = ws'"
      by(fastforce intro:Casts_Casts_eq_result)
    with eval_body' Ds' l2' eq1 eq2 eq3
    have eval_body'':"P,E(this ↦ Class(last Ds),pns [↦] Ts) ⊢ 
                            ⟨body,(h⇩₂,l⇩₂')⟩ ⇒ ⟨e⇩₂,(h',l')⟩"
      by simp
    from wf evals_vals wtes sconf' s eq3 have sconf'':"P,E ⊢ (h⇩₂,l⇩₂) √"
      by(fastforce intro:evals_preserves_sconf)
    have "P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ (h⇩₂,l⇩₂') √"
    proof(auto simp:sconf_def)
      from sconf'' show "P ⊢ h⇩₂ √" by(simp add:sconf_def)
    next
      { fix V v assume map:"[this ↦ Ref (a,Ds), pns [↦] vs'] V = Some v"
        have "∃T. (E(this ↦ Class (last Ds), pns [↦] Ts)) V = Some T ∧ 
                   P,h⇩₂ ⊢ v :≤ T"
        proof(cases "V ∈ set (this#pns)")
          case False with map show ?thesis by simp
        next
          case True
          hence "V = this ∨ V ∈ set pns" by simp
          thus ?thesis
          proof(rule disjE)
            assume V:"V = this"
            with map this_not_pns have "v = Ref(a,Ds)" by simp
            with V h2 subo this_not_pns have
              "(E(this ↦ Class (last Ds),pns [↦] Ts)) V = Some(Class (last Ds))"
              and "P,h⇩₂ ⊢ v :≤ Class (last Ds)" by simp_all
            thus ?thesis by simp
          next
            assume "V ∈ set pns"
            then obtain i where V:"V = pns!i" and length_i:"i < length pns"
              by(auto simp:in_set_conv_nth)
            from Casts have "length Ts = length vs'"
              by(induct rule:Casts_to.induct,auto)
            with length have "length pns = length vs'" by simp
            with map dist V length_i have v:"v = vs'!i" by(fastforce dest:maps_nth)
            from length dist length_i
            have env:"(E(this ↦ Class (last Ds))(pns [↦] Ts)) (pns!i) = Some(Ts!i)"
              by(rule_tac E="E(this ↦ Class (last Ds))" in nth_maps,simp_all)
            from wf Casts wtes subs eval'' sconf'
            have "∀i < length Ts. P,h⇩₂ ⊢ vs'!i :≤ Ts!i"
              by -(rule Casts_conf,auto)
            with length_i length env V v show ?thesis by simp
          qed
        qed }
      thus "P,h⇩₂ ⊢ l⇩₂' (:≤)⇩_w E(this ↦ Class (last Ds), pns [↦] Ts)"
        using l2' by(simp add:lconf_def)
    next
      { fix V Tx assume env:"(E(this ↦ Class (last Ds), pns [↦] Ts)) V = Some Tx"
        have "is_type P Tx"
        proof(cases "V ∈ set (this#pns)")
          case False
          with env sconf'' show ?thesis
            by(clarsimp simp:sconf_def envconf_def)
        next
          case True
          hence "V = this ∨ V ∈ set pns" by simp
          thus ?thesis
          proof(rule disjE)
            assume "V = this"
            with env this_not_pns have "Tx = Class(last Ds)" by simp
            with "class" show ?thesis by simp
          next
            assume "V ∈ set pns"
            then obtain i where V:"V = pns!i" and length_i:"i < length pns"
              by(auto simp:in_set_conv_nth)
            with dist length env have "Tx = Ts!i" by(fastforce dest:maps_nth)
            with length_i length have "Tx ∈ set Ts"
              by(fastforce simp:in_set_conv_nth)
            with param_type show ?thesis by simp
          qed
        qed }
      thus "P ⊢ E(this ↦ Class (last Ds), pns [↦] Ts) √" by (simp add:envconf_def)
    qed
    from IH3[OF eval_body'' wt_body this] have "e' = e⇩₂ ∧ (h⇩₃, l⇩₃) = (h',l')" .
    with eq3 s2 show "e' = e⇩₂ ∧ (h⇩₃, l⇩₂) = s⇩₂" by simp
  next
    fix s ws
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
    from IH1[OF eval_null wte sconf] show "e' = e⇩₂ ∧ (h⇩₃,l⇩₂) = s⇩₂" by simp
  qed
next
  case (CallNull E e s⇩₀ s⇩₁ es vs s⇩₂ Copt M e⇩₂ s⇩₂' T)
  have eval:"P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩"
    and wt:"P,E ⊢ Call e Copt M es :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
    ⟹ null = ei ∧ s⇩₁ = si"
    and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩₁ √⟧
    ⟹ map Val vs = esi ∧ s⇩₂ = si" by fact+
  from wt obtain C Ts where wte:"P,E ⊢ e :: Class C" and wtes:"P,E ⊢ es [::] Ts" 
    by(cases Copt)auto
  show ?case
  proof(cases Copt)
    assume "Copt = None"
    with eval have "P,E ⊢ ⟨e∙M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩" by simp
    thus ?thesis
    proof(rule eval_cases)
      fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex',s⇩₂'⟩"
      from IH1[OF eval_throw wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" 
        by simp
    next
      fix es' ex' s w ws
      assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
        and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es',s⇩₂'⟩"
      from IH1[OF eval_val wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_throw[simplified eq] wtes this] 
      show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" by(fastforce dest:map_Val_throw_False)
    next
      fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
          s ws ws'
      assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      from IH1[OF eval_ref wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" 
        by simp
    next
      fix s ws
      assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
        and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩₂'⟩"
        and e2:"e⇩₂ = THROW NullPointer"
      from IH1[OF eval_null wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_vals[simplified eq] wtes this] e2
      show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
    qed
  next
    fix C' assume "Copt = Some C'"
    with eval have "P,E ⊢ ⟨e∙(C'::)M(es),s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩" by simp
    thus ?thesis
    proof(rule eval_cases)
      fix ex' assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex',s⇩₂'⟩"
      from IH1[OF eval_throw wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" 
        by simp
    next
      fix es' ex' s w ws
      assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
        and evals_throw:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws@throw ex'#es',s⇩₂'⟩"
      from IH1[OF eval_val wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_val wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_throw[simplified eq] wtes this] 
      show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" by(fastforce dest:map_Val_throw_False)
    next
      fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
          s ws ws'
      assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref(a',Xs),s⟩"
      from IH1[OF eval_ref wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" 
        by simp
    next
      fix s ws
      assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⟩"
        and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨map Val ws,s⇩₂'⟩"
        and e2:"e⇩₂ = THROW NullPointer"
      from IH1[OF eval_null wte sconf] have eq:"s = s⇩₁" by simp
      with wf eval_null wte sconf have sconf':"P,E ⊢ s⇩₁ √"
        by(fastforce intro:eval_preserves_sconf)
      from IH2[OF evals_vals[simplified eq] wtes this] e2
      show "THROW NullPointer = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
    qed
  qed
next
  case (Block E V T e⇩₀ h⇩₀ l⇩₀ e⇩₁ h⇩₁ l⇩₁ e⇩₂ s⇩₂ T')
  have eval:"P,E ⊢ ⟨{V:T; e⇩₀},(h⇩₀, l⇩₀)⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ {V:T; e⇩₀} :: T'" and sconf:"P,E ⊢ (h⇩₀, l⇩₀) √"
    and IH:"⋀e⇩₂ s⇩₂ T'. ⟦P,E(V ↦ T) ⊢ ⟨e⇩₀,(h⇩₀, l⇩₀(V := None))⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; 
               P,E(V ↦ T) ⊢ e⇩₀ :: T'; P,E(V ↦ T) ⊢ (h⇩₀, l⇩₀(V := None)) √⟧
    ⟹ e⇩₁ = e⇩₂ ∧ (h⇩₁, l⇩₁) = s⇩₂" by fact+
  from wt have type:"is_type P T" and wte:"P,E(V ↦ T) ⊢ e⇩₀ :: T'" by auto
  from sconf type have sconf':"P,E(V ↦ T) ⊢ (h⇩₀, l⇩₀(V := None)) √"
    by(auto simp:sconf_def lconf_def envconf_def)
  from eval obtain h l where 
    eval':"P,E(V ↦ T) ⊢ ⟨e⇩₀,(h⇩₀,l⇩₀(V:=None))⟩ ⇒ ⟨e⇩₂,(h,l)⟩"
    and s2:"s⇩₂ = (h,l(V:=l⇩₀ V))" by (auto elim:eval_cases)
  from IH[OF eval' wte sconf'] s2 show ?case by simp
next
  case (Seq E e⇩₀ s⇩₀ v s⇩₁ e⇩₁ e⇩₂ s⇩₂ e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨e⇩₀;; e⇩₁,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    and wt:"P,E ⊢ e⇩₀;; e⇩₁ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₀ :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ Val v = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₁ √⟧ 
                     ⟹ e⇩₂ = ei ∧ s⇩₂ = si" by fact+
  from wt obtain T' where wte0:"P,E ⊢ e⇩₀ :: T'" and wte1:"P,E ⊢ e⇩₁ :: T" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s w 
    assume eval_val:"P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒ ⟨Val w,s⟩" 
      and eval':"P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    from IH1[OF eval_val wte0 sconf] have eq:"s = s⇩₁" by simp
    with wf eval_val wte0 sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval'[simplified eq] wte1 this] show "e⇩₂ = e⇩₂' ∧ s⇩₂ = s⇩₂'" .
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_throw wte0 sconf] show "e⇩₂ = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  qed
next
  case (SeqThrow E e⇩₀ s⇩₀ e s⇩₁ e⇩₁ e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨e⇩₀;; e⇩₁,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ e⇩₀;; e⇩₁ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₀ :: T; P,E ⊢ s⇩₀ √⟧
                     ⟹ throw e = ei ∧ s⇩₁ = si" by fact+
  from wt obtain T' where wte0:"P,E ⊢ e⇩₀ :: T'" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s w 
    assume eval_val:"P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
    from IH[OF eval_val wte0 sconf] show "throw e = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex 
    assume eval_throw:"P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
    from IH[OF eval_throw wte0 sconf] e2 show "throw e = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (CondT E e s⇩₀ s⇩₁ e⇩₁ e' s⇩₂ e⇩₂ e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    and wt:"P,E ⊢ if (e) e⇩₁ else e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ true = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₁,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₁ :: T; P,E ⊢ s⇩₁ √⟧ 
                    ⟹ e' = ei ∧ s⇩₂ = si" by fact+
  from wt have wte:"P,E ⊢ e :: Boolean" and wte1:"P,E ⊢ e⇩₁ :: T" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s 
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩" and eval':"P,E ⊢ ⟨e⇩₁,s⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    from IH1[OF eval_true wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_true wte sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval'[simplified eq] wte1 this] show "e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" .
  next
    fix s assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⟩"
    from IH1[OF eval_false wte sconf] show "e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_throw wte sconf] show "e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  qed
next
  case (CondF E e s⇩₀ s⇩₁ e⇩₂ e' s⇩₂ e⇩₁ e⇩₂' s⇩₂' T)
  have eval:"P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    and wt:"P,E ⊢ if (e) e⇩₁ else e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ false = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e⇩₂ :: T; P,E ⊢ s⇩₁ √⟧ 
                    ⟹ e' = ei ∧ s⇩₂ = si" by fact+
  from wt have wte:"P,E ⊢ e :: Boolean" and wte2:"P,E ⊢ e⇩₂ :: T" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s 
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩"
    from IH1[OF eval_true wte sconf] show "e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix s
    assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⟩"
      and eval':"P,E ⊢ ⟨e⇩₂,s⟩ ⇒ ⟨e⇩₂',s⇩₂'⟩"
    from IH1[OF eval_false wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_false wte sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval'[simplified eq] wte2 this] show "e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" .
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_throw wte sconf] show "e' = e⇩₂' ∧ s⇩₂ = s⇩₂'" by simp
  qed
next
  case (CondThrow E e s⇩₀ e' s⇩₁ e⇩₁ e⇩₂ e⇩₂' s⇩₂ T)
  have eval:"P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂,s⇩₀⟩ ⇒ ⟨e⇩₂',s⇩₂⟩"
    and wt:"P,E ⊢ if (e) e⇩₁ else e⇩₂ :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ throw e' = ei ∧ s⇩₁ = si" by fact+
  from wt have wte:"P,E ⊢ e :: Boolean" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix s 
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩"
    from IH[OF eval_true wte sconf] show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix s assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⟩"
    from IH[OF eval_false wte sconf] show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex
    assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2':"e⇩₂' = throw ex"
    from IH[OF eval_throw wte sconf] e2' show "throw e' = e⇩₂' ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (WhileF E e s⇩₀ s⇩₁ c e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀e⇩₂ s⇩₂ T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ false = e⇩₂ ∧ s⇩₁ = s⇩₂" by fact+
  from wt have wte:"P,E ⊢ e :: Boolean" by auto
  from eval show ?case
  proof(rule eval_cases)
    assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⇩₂⟩" and e2:"e⇩₂ = unit"
    from IH[OF eval_false wte sconf] e2 show "unit = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix s s' w
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩"
    from IH[OF eval_true wte sconf] show "unit = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "unit = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex s
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩"
    from IH[OF eval_true wte sconf] show "unit = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (WhileT E e s⇩₀ s⇩₁ c v⇩₁ s⇩₂ e⇩₃ s⇩₃ e⇩₂ s⇩₂' T)
  have eval:"P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩"
    and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ true = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨c,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ c :: T; P,E ⊢ s⇩₁ √⟧ 
                    ⟹ Val v⇩₁ = ei ∧ s⇩₂ = si"
    and IH3:"⋀ei si T. ⟦P,E ⊢ ⟨while (e) c,s⇩₂⟩ ⇒ ⟨ei,si⟩; P,E ⊢ while (e) c :: T; 
                         P,E ⊢ s⇩₂ √⟧
                    ⟹ e⇩₃ = ei ∧ s⇩₃ = si" by fact+
  from wt obtain T' where wte:"P,E ⊢ e :: Boolean" and wtc:"P,E ⊢ c :: T'" by auto
  from eval show ?case
  proof(rule eval_cases)
    assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⇩₂'⟩"
    from IH1[OF eval_false wte sconf] show "e⇩₃ = e⇩₂ ∧ s⇩₃ = s⇩₂'" by simp
  next
    fix s s' w
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩" 
      and eval_val:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨Val w,s'⟩"
      and eval_while:"P,E ⊢ ⟨while (e) c,s'⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩"
    from IH1[OF eval_true wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
   from IH2[OF eval_val[simplified eq] wtc this] have eq':"s' = s⇩₂" by simp
   with wf eval_val wtc sconf' eq have "P,E ⊢ s⇩₂ √"
     by(fastforce intro:eval_preserves_sconf)
   from IH3[OF eval_while[simplified eq'] wt this] show "e⇩₃ = e⇩₂ ∧ s⇩₃ = s⇩₂'" .
 next
   fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
   from IH1[OF eval_throw wte sconf] show "e⇩₃ = e⇩₂ ∧ s⇩₃ = s⇩₂'" by simp
 next
   fix ex s
   assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩" 
     and eval_throw:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_true wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
   from IH2[OF eval_throw[simplified eq] wtc this] show "e⇩₃ = e⇩₂ ∧ s⇩₃ = s⇩₂'" by simp
 qed
next
  case (WhileCondThrow E e s⇩₀ e' s⇩₁ c e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧
                    ⟹ throw e' = ei ∧ s⇩₁ = si" by fact+
  from wt have wte:"P,E ⊢ e :: Boolean" by auto
  from eval show ?case
  proof(rule eval_cases)
    assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⇩₂⟩"
    from IH[OF eval_false wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix s s' w
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩"
    from IH[OF eval_true wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex 
    assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
    from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex s
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩"
    from IH[OF eval_true wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (WhileBodyThrow E e s⇩₀ s⇩₁ c e' s⇩₂ e⇩₂ s⇩₂' T)
  have eval:"P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂'⟩"
    and wt:"P,E ⊢ while (e) c :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ true = ei ∧ s⇩₁ = si"
    and IH2:"⋀ei si T. ⟦P,E ⊢ ⟨c,s⇩₁⟩ ⇒ ⟨ei,si⟩; P,E ⊢ c :: T; P,E ⊢ s⇩₁ √⟧
                   ⟹ throw e' = ei ∧ s⇩₂ = si" by fact+
  from wt obtain T' where wte:"P,E ⊢ e :: Boolean" and wtc:"P,E ⊢ c :: T'" by auto
  from eval show ?case
  proof(rule eval_cases)
    assume eval_false:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨false,s⇩₂'⟩"
    from IH1[OF eval_false wte sconf] show "throw e' = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix s s' w
    assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩" 
      and eval_val:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨Val w,s'⟩"
    from IH1[OF eval_true wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
   from IH2[OF eval_val[simplified eq] wtc this] show "throw e' = e⇩₂ ∧ s⇩₂ = s⇩₂'"
     by simp
 next
   fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
   from IH1[OF eval_throw wte sconf] show "throw e' = e⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
 next
   fix ex s
   assume eval_true:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨true,s⟩" 
     and eval_throw:"P,E ⊢ ⟨c,s⟩ ⇒ ⟨throw ex,s⇩₂'⟩" and e2:"e⇩₂ = throw ex"
   from IH1[OF eval_true wte sconf] have eq:"s = s⇩₁" by simp
    with wf eval_true wte sconf have sconf':"P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
   from IH2[OF eval_throw[simplified eq] wtc this] e2 show "throw e' = e⇩₂ ∧ s⇩₂ = s⇩₂'"
     by simp
 qed
next
  case (Throw E e s⇩₀ r s⇩₁ e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨throw e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ throw e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                   ⟹ ref r = ei ∧ s⇩₁ = si" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix r'
    assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref r',s⇩₂⟩" and e2:"e⇩₂ = Throw r'"
    from IH[OF eval_ref wte sconf] e2 show "Throw r = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "Throw r = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "Throw r = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (ThrowNull E e s⇩₀ s⇩₁ e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨throw e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ throw e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                   ⟹ null = ei ∧ s⇩₁ = si" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix r' assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref r',s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩" and e2:"e⇩₂ = THROW NullPointer"
    from IH[OF eval_null wte sconf] e2 show "THROW NullPointer = e⇩₂ ∧ s⇩₁ = s⇩₂" 
      by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩"
    from IH[OF eval_throw wte sconf] show "THROW NullPointer = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case (ThrowThrow E e s⇩₀ e' s⇩₁ e⇩₂ s⇩₂ T)
  have eval:"P,E ⊢ ⟨throw e,s⇩₀⟩ ⇒ ⟨e⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ throw e :: T" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ throw e' = ei ∧ s⇩₁ = si" by fact+
  from wt obtain C where wte:"P,E ⊢ e :: Class C" by auto
  from eval show ?case
  proof(rule eval_cases)
    fix r' assume eval_ref:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ref r',s⇩₂⟩"
    from IH[OF eval_ref wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    assume eval_null:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨null,s⇩₂⟩"
    from IH[OF eval_null wte sconf] show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex 
    assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and e2:"e⇩₂ = throw ex"
    from IH[OF eval_throw wte sconf] e2 show "throw e' = e⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
next
  case Nil thus ?case by (auto elim:evals_cases)
next
  case (Cons E e s⇩₀ v s⇩₁ es es' s⇩₂ es⇩₂ s⇩₂' Ts)
  have evals:"P,E ⊢ ⟨e#es,s⇩₀⟩ [⇒] ⟨es⇩₂,s⇩₂'⟩"
    and wt:"P,E ⊢ e#es [::] Ts" and sconf:"P,E ⊢ s⇩₀ √"
    and IH1:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ Val v = ei ∧ s⇩₁ = si"
    and IH2:"⋀esi si Ts. ⟦P,E ⊢ ⟨es,s⇩₁⟩ [⇒] ⟨esi,si⟩; P,E ⊢ es [::] Ts; P,E ⊢ s⇩₁ √⟧
                    ⟹ es' = esi ∧ s⇩₂ = si" by fact+
  from wt obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
  with wt have wte:"P,E ⊢ e :: T'" and wtes:"P,E ⊢ es [::] Ts'" by auto
  from evals show ?case
  proof(rule evals_cases)
    fix es'' s w
    assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
      and evals_vals:"P,E ⊢ ⟨es,s⟩ [⇒] ⟨es'',s⇩₂'⟩" and es2:"es⇩₂ = Val w#es''"
    from IH1[OF eval_val wte sconf] have s:"s = s⇩₁" and v:"v = w" by simp_all
    with wf eval_val wte sconf have "P,E ⊢ s⇩₁ √"
      by(fastforce intro:eval_preserves_sconf)
    from IH2[OF evals_vals[simplified s] wtes this] have "es' = es'' ∧ s⇩₂ = s⇩₂'" .
    with es2 v show "Val v # es' = es⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
  next
    fix ex assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂'⟩"
    from IH1[OF eval_throw wte sconf] show "Val v # es' = es⇩₂ ∧ s⇩₂ = s⇩₂'" by simp
  qed
next
  case (ConsThrow E e s⇩₀ e' s⇩₁ es es⇩₂ s⇩₂ Ts)
  have evals:"P,E ⊢ ⟨e#es,s⇩₀⟩ [⇒] ⟨es⇩₂,s⇩₂⟩"
    and wt:"P,E ⊢ e#es [::] Ts" and sconf:"P,E ⊢ s⇩₀ √"
    and IH:"⋀ei si T. ⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨ei,si⟩; P,E ⊢ e :: T; P,E ⊢ s⇩₀ √⟧ 
                    ⟹ throw e' = ei ∧ s⇩₁ = si" by fact+
  from wt obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
  with wt have wte:"P,E ⊢ e :: T'" by auto
  from evals show ?case
  proof(rule evals_cases)
    fix es'' s w
    assume eval_val:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨Val w,s⟩"
    from IH[OF eval_val wte sconf] show "throw e'#es = es⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  next
    fix ex 
    assume eval_throw:"P,E ⊢ ⟨e,s⇩₀⟩ ⇒ ⟨throw ex,s⇩₂⟩" and es2:"es⇩₂ = throw ex#es"
    from IH[OF eval_throw wte sconf] es2 show "throw e'#es = es⇩₂ ∧ s⇩₁ = s⇩₂" by simp
  qed
qed


end

Theory Execute

(*  Title:       CoreC++
    Author:      Daniel Wasserrab, Stefan Berghofer
    Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
*)

section ‹Code generation for Semantics and Type System›

theory Execute
imports BigStep WellType
  "HOL-Library.AList_Mapping"
  "HOL-Library.Code_Target_Numeral"
begin

subsection‹General redefinitions›

inductive app :: "'a list ⇒ 'a list ⇒ 'a list ⇒ bool"
where
  "app [] ys ys"
| "app xs ys zs ⟹ app (x # xs) ys (x # zs)"

theorem app_eq1: "⋀ys zs. zs = xs @ ys ⟹ app xs ys zs"
  apply (induct xs)
   apply simp
   apply (rule app.intros)
  apply simp
  apply (iprover intro: app.intros)
  done

theorem app_eq2: "app xs ys zs ⟹ zs = xs @ ys"
  by (erule app.induct) simp_all

theorem app_eq: "app xs ys zs = (zs = xs @ ys)"
  apply (rule iffI)
   apply (erule app_eq2)
  apply (erule app_eq1)
  done

code_pred
  (modes:
    i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool, i ⇒ o ⇒ i ⇒ bool,
    o ⇒ i ⇒ i ⇒ bool, o ⇒ o ⇒ i ⇒ bool as reverse_app)
  app
.

declare rtranclp_rtrancl_eq[code del]

lemmas [code_pred_intro] = rtranclp.rtrancl_refl converse_rtranclp_into_rtranclp

code_pred 
  (modes: 
   (i => o => bool) => i => i => bool,
   (i => o => bool) => i => o => bool)
  rtranclp
by(erule converse_rtranclpE) blast+

definition Set_project :: "('a × 'b) set => 'a => 'b set"
where "Set_project A a = {b. (a, b) ∈ A}"

lemma Set_project_set [code]:
  "Set_project (set xs) a = set (List.map_filter (λ(a', b). if a = a' then Some b else None) xs)"
by(auto simp add: Set_project_def map_filter_def intro: rev_image_eqI split: if_split_asm)


text‹Redefine map Val vs›

inductive map_val :: "expr list ⇒ val list ⇒ bool"
where
  Nil: "map_val [] []"
| Cons: "map_val xs ys ⟹ map_val (Val y # xs) (y # ys)"

code_pred 
  (modes: i ⇒ i ⇒ bool, i ⇒ o ⇒ bool)
  map_val
.

inductive map_val2 :: "expr list ⇒ val list ⇒ expr list ⇒ bool"
where
  Nil: "map_val2 [] [] []"
| Cons: "map_val2 xs ys zs ⟹ map_val2 (Val y # xs) (y # ys) zs"
| Throw: "map_val2 (throw e # xs) [] (throw e # xs)"

code_pred
  (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ o ⇒ o ⇒ bool)
  map_val2
.

theorem map_val_conv: "(xs = map Val ys) = map_val xs ys"
(*<*)
proof -
  have "⋀ys. xs = map Val ys ⟹ map_val xs ys"
    apply (induct xs type:list)
     apply (case_tac ys)
      apply simp
      apply (rule map_val.Nil)
     apply simp
    apply (case_tac ys)
     apply simp
    apply simp

    apply (rule map_val.Cons)
    apply simp
    done
  moreover have "map_val xs ys ⟹ xs = map Val ys"
    by (erule map_val.induct) simp+
  ultimately show ?thesis ..
qed
(*>*)

theorem map_val2_conv:
 "(xs = map Val ys @ throw e # zs) = map_val2 xs ys (throw e # zs)"
(*<*)
proof -
  have "⋀ys. xs = map Val ys @ throw e # zs ⟹ map_val2 xs ys (throw e # zs)"
    apply (induct xs type:list)
     apply (case_tac ys)
      apply simp
     apply simp
    apply simp
    apply (case_tac ys)
     apply simp
     apply (rule map_val2.Throw)
    apply simp
    apply (rule map_val2.Cons)
    apply simp
    done
  moreover have "map_val2 xs ys (throw e # zs) ⟹ xs = map Val ys @ throw e # zs"
    by (erule map_val2.induct) simp+
  ultimately show ?thesis ..
qed
(*>*)


subsection‹Code generation›

lemma subclsRp_code [code_pred_intro]:
  "⟦ class P C = ⌊(Bs, rest)⌋; Predicate_Compile.contains (set Bs) (Repeats D) ⟧ ⟹ subclsRp P C D"
by(auto intro: subclsRp.intros simp add: contains_def)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
  subclsRp
by(erule subclsRp.cases)(fastforce simp add: Predicate_Compile.contains_def)

lemma subclsR_code [code_pred_inline]:
  "P ⊢ C ≺⇩_R D ⟷ subclsRp P C D"
by(simp add: subclsR_def)

lemma subclsSp_code [code_pred_intro]:
  "⟦ class P C = ⌊(Bs, rest)⌋; Predicate_Compile.contains (set Bs) (Shares D) ⟧ ⟹ subclsSp P C D"
by(auto intro: subclsSp.intros simp add: Predicate_Compile.contains_def)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
  subclsSp
by(erule subclsSp.cases)(fastforce simp add: Predicate_Compile.contains_def)

declare SubobjsR_Base [code_pred_intro]
lemma SubobjsR_Rep_code [code_pred_intro]:
  "⟦subclsRp P C D; Subobjs⇩_R P D Cs⟧ ⟹ Subobjs⇩_R P C (C # Cs)"
by(simp add: SubobjsR_Rep subclsR_def)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
  Subobjs⇩_R
by(erule Subobjs⇩_R.cases)(auto simp add: subclsR_code)

lemma subcls1p_code [code_pred_intro]:
  "⟦class P C = Some (Bs,rest); Predicate_Compile.contains (baseClasses Bs) D ⟧ ⟹ subcls1p P C D"
by(auto intro: subcls1p.intros simp add: Predicate_Compile.contains_def)

code_pred (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
  subcls1p
by(fastforce elim!: subcls1p.cases simp add: Predicate_Compile.contains_def) 

declare Subobjs_Rep [code_pred_intro]
lemma Subobjs_Sh_code [code_pred_intro]:
  "⟦ (subcls1p P)^** C C'; subclsSp P C' D; Subobjs⇩_R P D Cs⟧
  ⟹ Subobjs P C Cs"
by(rule Subobjs_Sh)(simp_all add: rtrancl_def subcls1_def subclsS_def)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ bool)
  Subobjs
by(erule Subobjs.cases)(auto simp add: rtrancl_def subcls1_def subclsS_def)

definition widen_unique :: "prog ⇒ cname ⇒ cname ⇒ path ⇒ bool"
where "widen_unique P C D Cs ⟷ (∀Cs'. Subobjs P C Cs' ⟶ last Cs' = D ⟶ Cs = Cs')"

code_pred [inductify, skip_proof] widen_unique .

lemma widen_subcls':
  "⟦Subobjs P C Cs'; last Cs' = D; widen_unique P C D Cs' ⟧
⟹ P ⊢ Class C ≤ Class D"
by(rule widen_subcls,auto simp:path_unique_def widen_unique_def)

declare 
  widen_refl [code_pred_intro]
  widen_subcls' [code_pred_intro widen_subcls]
  widen_null [code_pred_intro]

code_pred
  (modes: i ⇒ i ⇒ i ⇒ bool)
  widen
by(erule widen.cases)(auto simp add: path_unique_def widen_unique_def)

code_pred 
  (modes: i ⇒ i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ o ⇒ i ⇒ bool, i ⇒ i ⇒ o ⇒ o ⇒ bool)
  leq_path1p 
.

lemma leq_path_unfold: "P,C ⊢ Cs ⊑ Ds ⟷ (leq_path1p P C)^** Cs Ds"
by(simp add: leq_path1_def rtrancl_def)

code_pred
   (modes: i => i => i => o => bool, i => i => i => i =>  bool)
   [inductify,skip_proof] 
   path_via 
.


lemma path_unique_eq [code_pred_def]: "P ⊢ Path C to D unique ⟷
  (∃Cs. Subobjs P C Cs ∧ last Cs = D ∧ (∀Cs'. Subobjs P C Cs' ⟶ last Cs' = D ⟶ Cs = Cs'))"
by(auto simp add: path_unique_def)

code_pred
   (modes: i => i => o => bool, i => i => i => bool) 
   [inductify, skip_proof]
   path_unique .

text ‹Redefine MethodDefs and FieldDecls›

(* FIXME: These predicates should be defined inductively in the first place! *)

definition MethodDefs' :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ method ⇒ bool" where
  "MethodDefs' P C M Cs mthd ≡ (Cs, mthd) ∈ MethodDefs P C M"

lemma [code_pred_intro]:
  "Subobjs P C Cs ⟹ class P (last Cs) = ⌊(Bs,fs,ms)⌋ ⟹ map_of ms M =  ⌊mthd⌋ ⟹
   MethodDefs' P C M Cs mthd"
 by (simp add: MethodDefs_def MethodDefs'_def)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
  MethodDefs'
by(fastforce simp add: MethodDefs_def MethodDefs'_def)


definition FieldDecls' :: "prog ⇒ cname ⇒ vname ⇒ path ⇒ ty ⇒ bool" where
  "FieldDecls' P C F Cs T ≡ (Cs, T) ∈ FieldDecls P C F"

lemma [code_pred_intro]:
  "Subobjs P C Cs ⟹ class P (last Cs) = ⌊(Bs,fs,ms)⌋ ⟹ map_of fs F =  ⌊T⌋ ⟹
   FieldDecls' P C F Cs T"
by (simp add: FieldDecls_def FieldDecls'_def)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
  FieldDecls'
by(fastforce simp add: FieldDecls_def FieldDecls'_def)



definition MinimalMethodDefs' :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ method ⇒ bool" where
  "MinimalMethodDefs' P C M Cs mthd ≡ (Cs, mthd) ∈ MinimalMethodDefs P C M"

definition MinimalMethodDefs_unique :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ bool"
where
  "MinimalMethodDefs_unique P C M Cs ⟷ 
  (∀Cs' mthd. MethodDefs' P C M Cs' mthd ⟶ (leq_path1p P C)^** Cs' Cs ⟶ Cs' = Cs)"

code_pred [inductify, skip_proof] MinimalMethodDefs_unique .

lemma [code_pred_intro]:
  "MethodDefs' P C M Cs mthd ⟹ MinimalMethodDefs_unique P C M Cs ⟹
   MinimalMethodDefs' P C M Cs mthd"
by (fastforce simp add:MinimalMethodDefs_def MinimalMethodDefs'_def MethodDefs'_def MinimalMethodDefs_unique_def leq_path_unfold)

code_pred
  (modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool)
  MinimalMethodDefs' 
by(fastforce simp add:MinimalMethodDefs_def MinimalMethodDefs'_def MethodDefs'_def MinimalMethodDefs_unique_def leq_path_unfold)



definition LeastMethodDef_unique :: "prog ⇒ cname ⇒ mname ⇒ path ⇒ bool"
where
  "LeastMethodDef_unique P C M Cs ⟷
  (∀Cs' mthd'. MethodDefs' P C M Cs' mthd' ⟶ (leq_path1p P C)^** Cs Cs')"

code_pred [inductify, skip_proof] LeastMethodDef_unique .

lemma LeastMethodDef_unfold:
  "P ⊢ C has least M = mthd via Cs ⟷
   MethodDefs' P C M Cs mthd ∧ LeastMethodDef_unique P C M Cs"
by(fastforce simp add: LeastMethodDef_def MethodDefs'_def leq_path_unfold LeastMethodDef_unique_def)

lemma LeastMethodDef_intro [code_pred_intro]:
  "⟦ MethodDefs' P C M Cs mthd; LeastMethodDef_unique P C M Cs ⟧
  ⟹ P ⊢ C has least M = mthd via Cs"
by(simp add: LeastMethodDef_unfold LeastMethodDef_unique_def)

code_pred (modes: i => i => i => o => o => bool)
  LeastMethodDef
by(simp add: LeastMethodDef_unfold LeastMethodDef_unique_def)


definition OverriderMethodDefs' :: "prog ⇒ subobj ⇒ mname ⇒ path ⇒ method ⇒ bool" where
  "OverriderMethodDefs' P R M Cs mthd ≡ (Cs, mthd) ∈ OverriderMethodDefs P R M"

lemma Overrider1 [code_pred_intro]:
  "P ⊢ (ldc R) has least M = mthd' via Cs' ⟹ 
   MinimalMethodDefs' P (mdc R) M Cs mthd ⟹
   last (snd R) = hd Cs' ⟹ (leq_path1p P (mdc R))^** Cs (snd R @ tl Cs') ⟹
   OverriderMethodDefs' P R M Cs mthd"
apply(simp add:OverriderMethodDefs_def OverriderMethodDefs'_def MinimalMethodDefs'_def appendPath_def leq_path_unfold)
apply(rule_tac x="Cs'" in exI)
apply clarsimp
apply(cases mthd')
apply blast
done

lemma Overrider2 [code_pred_intro]:
  "P ⊢ (ldc R) has least M = mthd' via Cs' ⟹ 
   MinimalMethodDefs' P (mdc R) M Cs mthd ⟹
   last (snd R) ≠ hd Cs' ⟹ (leq_path1p P (mdc R))^** Cs Cs' ⟹
   OverriderMethodDefs' P R M Cs mthd"
by(auto simp add:OverriderMethodDefs_def OverriderMethodDefs'_def MinimalMethodDefs'_def appendPath_def leq_path_unfold simp del: split_paired_Ex)


code_pred
  (modes: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
  OverriderMethodDefs'
apply(clarsimp simp add: OverriderMethodDefs'_def MinimalMethodDefs'_def MethodDefs'_def OverriderMethodDefs_def appendPath_def leq_path_unfold)
apply(case_tac "last xb = hd Cs'")
 apply(simp)

apply(thin_tac "PROP _")
apply(simp add: leq_path1_def)
done


definition WTDynCast_ex :: "prog ⇒ cname ⇒ cname ⇒ bool"
where "WTDynCast_ex P D C ⟷ (∃Cs. P ⊢ Path D to C via Cs)"

code_pred [inductify, skip_proof] WTDynCast_ex .

lemma WTDynCast_new:
  "⟦P,E ⊢ e :: Class D; is_class P C;
    P ⊢ Path D to C unique ∨ ¬ WTDynCast_ex P D C⟧ 
  ⟹ P,E ⊢ Cast C e :: Class C"
by(rule WTDynCast)(auto simp add: WTDynCast_ex_def)

definition WTStaticCast_sub :: "prog ⇒ cname ⇒ cname ⇒ bool"
where "WTStaticCast_sub P C D ⟷ 
  P ⊢ Path D to C unique ∨ 
  ((subcls1p P)^** C D ∧ (∀Cs. P ⊢ Path C to D via Cs ⟶ Subobjs⇩_R P C Cs))"

code_pred [inductify, skip_proof] WTStaticCast_sub .

lemma WTStaticCast_new:
  "⟦P,E ⊢ e :: Class D; is_class P C; WTStaticCast_sub P C D ⟧
  ⟹ P,E ⊢ ⦇C⦈e :: Class C"
by (rule WTStaticCast)(auto simp add: WTStaticCast_sub_def subcls1_def rtrancl_def)

lemma WTBinOp1: "⟦ P,E ⊢ e⇩₁ :: T;  P,E ⊢ e⇩₂ :: T⟧
  ⟹ P,E ⊢ e⇩₁ «Eq» e⇩₂ :: Boolean"
  apply (rule WTBinOp)
  apply assumption+
  apply simp
  done

lemma WTBinOp2: "⟦ P,E ⊢ e⇩₁ :: Integer;  P,E ⊢ e⇩₂ :: Integer ⟧
  ⟹ P,E ⊢ e⇩₁ «Add» e⇩₂ :: Integer"
  apply (rule WTBinOp)
  apply assumption+
  apply simp
  done


lemma LeastFieldDecl_unfold [code_pred_def]: 
  "P ⊢ C has least F:T via Cs ⟷
   FieldDecls' P C F Cs T ∧ (∀Cs' T'. FieldDecls' P C F Cs' T' ⟶ (leq_path1p P C)^** Cs Cs')"
by(auto simp add: LeastFieldDecl_def FieldDecls'_def leq_path_unfold)

code_pred [inductify, skip_proof] LeastFieldDecl .


lemmas [code_pred_intro] = WT_WTs.WTNew
declare
  WTDynCast_new[code_pred_intro WTDynCast_new]
  WTStaticCast_new[code_pred_intro WTStaticCast_new]
lemmas [code_pred_intro] = WT_WTs.WTVal WT_WTs.WTVar 
declare
  WTBinOp1[code_pred_intro WTBinOp1]
  WTBinOp2 [code_pred_intro WTBinOp2]
lemmas [code_pred_intro] =
  WT_WTs.WTLAss WT_WTs.WTFAcc WT_WTs.WTFAss WT_WTs.WTCall WTStaticCall
  WT_WTs.WTBlock WT_WTs.WTSeq WT_WTs.WTCond WT_WTs.WTWhile WT_WTs.WTThrow
lemmas [code_pred_intro] = WT_WTs.WTNil WT_WTs.WTCons

code_pred
  (modes: WT: i ⇒ i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ bool
   and WTs: i ⇒ i ⇒ i ⇒ i ⇒ bool, i ⇒ i ⇒ i ⇒ o ⇒ bool)
  WT
proof -
  case WT
  from WT.prems show thesis
  proof(cases (no_simp) rule: WT.cases)
    case WTDynCast thus thesis
      by(rule WT.WTDynCast_new[OF refl, unfolded WTDynCast_ex_def, simplified])
  next
    case WTStaticCast thus ?thesis
      unfolding subcls1_def rtrancl_def mem_Collect_eq prod.case
      by(rule WT.WTStaticCast_new[OF refl, unfolded WTStaticCast_sub_def])
  next
    case WTBinOp thus ?thesis
      by(split bop.split_asm)(simp_all, (erule (4) WT.WTBinOp1[OF refl] WT.WTBinOp2[OF refl])+)
  qed(assumption|erule (2) WT.that[OF refl])+
next
  case WTs
  from WTs.prems show thesis
    by(cases (no_simp) rule: WTs.cases)(assumption|erule (2) WTs.that[OF refl])+
qed

lemma casts_to_code [code_pred_intro]:
  "(case T of Class C ⇒ False | _ ⇒ True) ⟹ P ⊢ T casts v to v"
  "P ⊢ Class C casts Null to Null"
  "⟦Subobjs P (last Cs) Cs'; last Cs' = C;
    last Cs = hd Cs'; Cs @ tl Cs' = Ds⟧ 
  ⟹ P ⊢ Class C casts Ref(a,Cs) to Ref(a,Ds)"
  "⟦Subobjs P (last Cs) Cs'; last Cs' = C; last Cs ≠ hd Cs'⟧
  ⟹ P ⊢ Class C casts Ref(a,Cs) to Ref(a,Cs')"
by(auto intro: casts_to.intros simp add: path_via_def appendPath_def)

code_pred (modes: i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ bool)
  casts_to
apply(erule casts_to.cases)
  apply(fastforce split: ty.splits)
 apply simp
apply(fastforce simp add: appendPath_def path_via_def split: if_split_asm)
done

code_pred 
  (modes: i ⇒ i ⇒ i ⇒ o ⇒ bool, i ⇒ i ⇒ i ⇒ i ⇒ bool)
  Casts_to
.


lemma card_eq_1_iff_ex1: "x ∈ A ⟹ card A = 1 ⟷ A = {x}"
apply(rule iffI)
 apply(rule equalityI)
  apply(rule subsetI)
  apply(subgoal_tac "card {x, xa} ≤ card A")
   apply(auto intro: ccontr)[1]
  apply(rule card_mono)
   apply simp_all
apply(metis Suc_n_not_n card.infinite)
done

lemma FinalOverriderMethodDef_unfold [code_pred_def]:
  "P ⊢ R has overrider M = mthd via Cs ⟷
   OverriderMethodDefs' P R M Cs mthd ∧ 
   (∀Cs' mthd'. OverriderMethodDefs' P R M Cs' mthd' ⟶ Cs = Cs' ∧ mthd = mthd')"
by(auto simp add: FinalOverriderMethodDef_def OverriderMethodDefs'_def card_eq_1_iff_ex1 simp del: One_nat_def)

code_pred
  (modes: i => i => i => o => o => bool)
  [inductify, skip_proof]
  FinalOverriderMethodDef
.

code_pred
  (modes: i => i => i => i => o => o => bool, i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ i ⇒ bool)
  [inductify]
  SelectMethodDef 
.

text ‹Isomorphic subo with mapping instead of a map›

type_synonym subo' = "(path × (vname, val) mapping)"
type_synonym obj'  = "cname × subo' set"

lift_definition init_class_fieldmap' :: "prog ⇒ cname ⇒ (vname, val) mapping" is "init_class_fieldmap" .

lemma init_class_fieldmap'_code [code]:
  "init_class_fieldmap' P C =
     Mapping (map (λ(F,T).(F,default_val T)) (fst(snd(the(class P C)))) )"
by transfer(simp add: init_class_fieldmap_def)

lift_definition init_obj' :: "prog ⇒ cname ⇒ subo' ⇒ bool" is init_obj .

lemma init_obj'_intros [code_pred_intro]: 
  "Subobjs P C Cs ⟹ init_obj' P C (Cs, init_class_fieldmap' P (last Cs))"
by(transfer)(rule init_obj.intros)

code_pred
  (modes: i ⇒ i ⇒ o ⇒ bool as init_obj_pred)
  init_obj'
by transfer(erule init_obj.cases, blast)


lemma init_obj_pred_conv: "set_of_pred (init_obj_pred P C) = Collect (init_obj' P C)"
by(auto elim: init_obj_predE intro: init_obj_predI)

lift_definition blank' :: "prog ⇒ cname ⇒ obj'" is "blank" .

lemma blank'_code [code]:
  "blank' P C = (C, set_of_pred (init_obj_pred P C))"
unfolding init_obj_pred_conv by transfer(simp add: blank_def)

type_synonym heap'  = "addr ⇀ obj'"

abbreviation
  cname_of' :: "heap' ⇒ addr ⇒ cname" where
  "⋀hp. cname_of' hp a == fst (the (hp a))"

lift_definition new_Addr' :: "heap' ⇒ addr option" is "new_Addr" .

lift_definition start_heap' :: "prog ⇒ heap'" is "start_heap" .

lemma start_heap'_code [code]:
  "start_heap' P = Map.empty (addr_of_sys_xcpt NullPointer ↦ blank' P NullPointer)
                        (addr_of_sys_xcpt ClassCast ↦ blank' P ClassCast)
                        (addr_of_sys_xcpt OutOfMemory ↦ blank' P OutOfMemory)"
by transfer(simp add: start_heap_def)

type_synonym
  state'  = "heap' × locals"

lift_definition hp' :: "state' ⇒ heap'" is hp .

lemma hp'_code [code]: "hp' = fst"
by transfer simp

lift_definition lcl' :: "state' ⇒ locals" is lcl .

lemma lcl_code [code]: "lcl' = snd"
by transfer simp


lift_definition eval' :: "prog ⇒ env ⇒ expr ⇒ state' ⇒ expr ⇒ state' ⇒ bool"
          ("_,_ ⊢ ((1⟨_,/_⟩) ⇒''/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
  is eval .
lift_definition evals' :: "prog ⇒ env ⇒ expr list ⇒ state' ⇒ expr list ⇒ state' ⇒ bool"
           ("_,_ ⊢ ((1⟨_,/_⟩) [⇒'']/ (1⟨_,/_⟩))" [51,0,0,0,0] 81)
  is evals .

lemma New':
  "⟦ new_Addr' h = Some a; h' = h(a↦(blank' P C)) ⟧
  ⟹ P,E ⊢ ⟨new C,(h,l)⟩ ⇒' ⟨ref (a,[C]),(h',l)⟩"
by transfer(unfold blank_def, rule New)

lemma NewFail':
  "new_Addr' h = None ⟹
  P,E ⊢ ⟨new C, (h,l)⟩ ⇒' ⟨THROW OutOfMemory,(h,l)⟩"
by transfer(rule NewFail)

lemma StaticUpCast':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Cs),s⇩₁⟩; P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩_pCs' ⟧
  ⟹ P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒' ⟨ref (a,Ds),s⇩₁⟩"
by transfer(rule StaticUpCast)

lemma StaticDownCast'_new:  (* requires reverse append *)
  "⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Ds),s⇩₁⟩; app Cs [C] Ds'; app Ds' Cs' Ds⟧
  ⟹ P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒' ⟨ref(a,Cs@[C]),s⇩₁⟩"
apply transfer
apply (rule StaticDownCast)
apply (simp add: app_eq)
done

lemma StaticCastNull':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹
  P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩"
by transfer(rule StaticCastNull)

lemma StaticCastFail'_new: (* manual unfolding of subcls *)
"⟦ P,E ⊢ ⟨e,s⇩₀⟩⇒' ⟨ref (a,Cs),s⇩₁⟩;  ¬ (subcls1p P)^** (last Cs) C; C ∉ set Cs⟧
  ⟹ P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒' ⟨THROW ClassCast,s⇩₁⟩"
apply transfer
by (fastforce intro:StaticCastFail simp add: rtrancl_def subcls1_def)

lemma StaticCastThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨⦇C⦈e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule StaticCastThrow)

lemma StaticUpDynCast':
  "⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref(a,Cs),s⇩₁⟩; P ⊢ Path last Cs to C unique;
    P ⊢ Path last Cs to C via Cs'; Ds = Cs@⇩_pCs' ⟧
  ⟹ P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒' ⟨ref(a,Ds),s⇩₁⟩"
by transfer(rule StaticUpDynCast)

lemma StaticDownDynCast'_new: (* requires reverse append *)
  "⟦P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Ds),s⇩₁⟩; app Cs [C] Ds'; app Ds' Cs' Ds⟧
  ⟹ P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒' ⟨ref(a,Cs@[C]),s⇩₁⟩"
apply transfer
apply (rule StaticDownDynCast)
apply (simp add: app_eq)
done

lemma DynCast':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Cs),(h,l)⟩; h a = Some(D,S);
    P ⊢ Path D to C via Cs'; P ⊢ Path D to C unique ⟧
  ⟹ P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒' ⟨ref (a,Cs'),(h,l)⟩"
by transfer(rule DynCast)

lemma DynCastNull':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹
  P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩"
by transfer(rule DynCastNull)

lemma DynCastFail':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩⇒' ⟨ref (a,Cs),(h,l)⟩; h a = Some(D,S); ¬ P ⊢ Path D to C unique;
    ¬ P ⊢ Path last Cs to C unique; C ∉ set Cs ⟧
  ⟹ P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒' ⟨null,(h,l)⟩"
by transfer(rule DynCastFail)

lemma DynCastThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨Cast C e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule DynCastThrow)

lemma Val':
  "P,E ⊢ ⟨Val v,s⟩ ⇒' ⟨Val v,s⟩"
by transfer(rule Val)

lemma BinOp':
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨Val v⇩₁,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨Val v⇩₂,s⇩₂⟩; 
    binop(bop,v⇩₁,v⇩₂) = Some v ⟧
  ⟹ P,E ⊢ ⟨e⇩₁ «bop» e⇩₂,s⇩₀⟩⇒'⟨Val v,s⇩₂⟩"
by transfer(rule BinOp)

lemma BinOpThrow1':
  "P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨throw e,s⇩₁⟩ ⟹
  P,E ⊢ ⟨e⇩₁ «bop» e⇩₂, s⇩₀⟩ ⇒' ⟨throw e,s⇩₁⟩"
by transfer(rule BinOpThrow1)

lemma BinOpThrow2':
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨Val v⇩₁,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨throw e,s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨e⇩₁ «bop» e⇩₂,s⇩₀⟩ ⇒' ⟨throw e,s⇩₂⟩"
by transfer(rule BinOpThrow2)

lemma Var':
  "l V = Some v ⟹
  P,E ⊢ ⟨Var V,(h,l)⟩ ⇒' ⟨Val v,(h,l)⟩"
by transfer(rule Var)

lemma LAss':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨Val v,(h,l)⟩; E V = Some T;
     P ⊢ T casts v to v'; l' = l(V↦v') ⟧
  ⟹ P,E ⊢ ⟨V:=e,s⇩₀⟩ ⇒' ⟨Val v',(h,l')⟩"
by (transfer) (erule (3) LAss)

lemma LAssThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨V:=e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule LAssThrow)

lemma FAcc'_new: (* iteration over set *)
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Cs'),(h,l)⟩; h a = Some(D,S);
     Ds = Cs'@⇩_pCs; Predicate_Compile.contains (Set_project S Ds) fs; Mapping.lookup fs F = Some v ⟧
  ⟹ P,E ⊢ ⟨e∙F{Cs},s⇩₀⟩ ⇒' ⟨Val v,(h,l)⟩"
unfolding Set_project_def mem_Collect_eq Predicate_Compile.contains_def
by transfer(rule FAcc)

lemma FAccNull':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹
  P,E ⊢ ⟨e∙F{Cs},s⇩₀⟩ ⇒' ⟨THROW NullPointer,s⇩₁⟩" 
by transfer(rule FAccNull)

lemma FAccThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨e∙F{Cs},s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule FAccThrow)

lemma FAss'_new: (* iteration over set *)
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨ref (a,Cs'),s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨Val v,(h⇩₂,l⇩₂)⟩;
     h⇩₂ a = Some(D,S); P ⊢ (last Cs') has least F:T via Cs; P ⊢ T casts v to v';
     Ds = Cs'@⇩_pCs;  Predicate_Compile.contains (Set_project S Ds) fs; fs' = Mapping.update F v' fs;
     S' = S - {(Ds,fs)} ∪ {(Ds,fs')}; h⇩₂' = h⇩₂(a↦(D,S'))⟧
  ⟹ P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂,s⇩₀⟩ ⇒' ⟨Val v',(h⇩₂',l⇩₂)⟩"
unfolding Predicate_Compile.contains_def Set_project_def mem_Collect_eq
by transfer(rule FAss)

lemma FAssNull':
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩;  P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨Val v,s⇩₂⟩ ⟧ ⟹
  P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂,s⇩₀⟩ ⇒' ⟨THROW NullPointer,s⇩₂⟩" 
by transfer(rule FAssNull)

lemma FAssThrow1':
  "P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule FAssThrow1)

lemma FAssThrow2':
  "⟦ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨Val v,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨throw e',s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨e⇩₁∙F{Cs}:=e⇩₂,s⇩₀⟩ ⇒' ⟨throw e',s⇩₂⟩"
by transfer(rule FAssThrow2)

lemma CallObjThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule CallObjThrow)

lemma CallParamsThrow'_new: (* requires inverse map Val and append *)
  "⟦ P,E ⊢ ⟨e,s0⟩ ⇒' ⟨Val v,s1⟩; P,E ⊢ ⟨es,s1⟩ [⇒'] ⟨evs,s2⟩;
     map_val2 evs vs (throw ex # es') ⟧
   ⟹ P,E ⊢ ⟨Call e Copt M es,s0⟩ ⇒' ⟨throw ex,s2⟩"
apply transfer
apply(rule eval_evals.CallParamsThrow, assumption+)
apply(simp add: map_val2_conv[symmetric])
done

lemma Call'_new: (* requires inverse map Val *)
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Cs),s⇩₁⟩;  P,E ⊢ ⟨ps,s⇩₁⟩ [⇒'] ⟨evs,(h⇩₂,l⇩₂)⟩;
     map_val evs vs;
     h⇩₂ a = Some(C,S);  P ⊢ last Cs has least M = (Ts',T',pns',body') via Ds;
     P ⊢ (C,Cs@⇩_pDs) selects M = (Ts,T,pns,body) via Cs'; length vs = length pns; 
     P ⊢ Ts Casts vs to vs'; l⇩₂' = [this↦Ref (a,Cs'), pns[↦]vs'];
     new_body = (case T' of Class D ⇒ ⦇D⦈body   | _  ⇒ body);  
     P,E(this↦Class(last Cs'), pns[↦]Ts) ⊢ ⟨new_body,(h⇩₂,l⇩₂')⟩ ⇒' ⟨e',(h⇩₃,l⇩₃)⟩ ⟧
  ⟹ P,E ⊢ ⟨e∙M(ps),s⇩₀⟩ ⇒' ⟨e',(h⇩₃,l⇩₂)⟩"
apply transfer
apply(rule Call)
apply assumption+
apply(simp add: map_val_conv[symmetric])
apply assumption+
done

lemma StaticCall'_new: (* requires inverse map Val *)
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a,Cs),s⇩₁⟩;  P,E ⊢ ⟨ps,s⇩₁⟩ [⇒'] ⟨evs,(h⇩₂,l⇩₂)⟩;
     map_val evs vs;
     P ⊢ Path (last Cs) to C unique; P ⊢ Path (last Cs) to C via Cs'';
     P ⊢ C has least M = (Ts,T,pns,body) via Cs'; Ds = (Cs@⇩_pCs'')@⇩_pCs';
     length vs = length pns; P ⊢ Ts Casts vs to vs'; 
     l⇩₂' = [this↦Ref (a,Ds), pns[↦]vs'];
     P,E(this↦Class(last Ds), pns[↦]Ts) ⊢ ⟨body,(h⇩₂,l⇩₂')⟩ ⇒' ⟨e',(h⇩₃,l⇩₃)⟩ ⟧
  ⟹ P,E ⊢ ⟨e∙(C::)M(ps),s⇩₀⟩ ⇒' ⟨e',(h⇩₃,l⇩₂)⟩"
apply transfer
apply(rule StaticCall)
apply(assumption)+
apply(simp add: map_val_conv[symmetric])
apply assumption+
done

lemma CallNull'_new: (* requires inverse map Val *)
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩;  P,E ⊢ ⟨es,s⇩₁⟩ [⇒'] ⟨evs,s⇩₂⟩; map_val evs vs ⟧
  ⟹ P,E ⊢ ⟨Call e Copt M es,s⇩₀⟩ ⇒' ⟨THROW NullPointer,s⇩₂⟩"
apply transfer
apply(rule CallNull, assumption+)
apply(simp add: map_val_conv[symmetric])
done

lemma Block':
  "⟦P,E(V ↦ T) ⊢ ⟨e⇩₀,(h⇩₀,l⇩₀(V:=None))⟩ ⇒' ⟨e⇩₁,(h⇩₁,l⇩₁)⟩ ⟧ ⟹
  P,E ⊢ ⟨{V:T; e⇩₀},(h⇩₀,l⇩₀)⟩ ⇒' ⟨e⇩₁,(h⇩₁,l⇩₁(V:=l⇩₀ V))⟩"
by transfer(rule Block)

lemma Seq':
  "⟦ P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒' ⟨Val v,s⇩₁⟩; P,E ⊢ ⟨e⇩₁,s⇩₁⟩ ⇒' ⟨e⇩₂,s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨e⇩₀;;e⇩₁,s⇩₀⟩ ⇒' ⟨e⇩₂,s⇩₂⟩"
by transfer(rule Seq)

lemma SeqThrow':
  "P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒' ⟨throw e,s⇩₁⟩ ⟹
  P,E ⊢ ⟨e⇩₀;;e⇩₁,s⇩₀⟩⇒'⟨throw e,s⇩₁⟩"
by transfer(rule SeqThrow)

lemma CondT':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨true,s⇩₁⟩; P,E ⊢ ⟨e⇩₁,s⇩₁⟩ ⇒' ⟨e',s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂,s⇩₀⟩ ⇒' ⟨e',s⇩₂⟩"
by transfer(rule CondT)

lemma CondF':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨false,s⇩₁⟩; P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨e',s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂,s⇩₀⟩ ⇒' ⟨e',s⇩₂⟩"
by transfer(rule CondF)

lemma CondThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨if (e) e⇩₁ else e⇩₂, s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule CondThrow)

lemma WhileF':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨false,s⇩₁⟩ ⟹
  P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒' ⟨unit,s⇩₁⟩"
by transfer(rule WhileF)

lemma WhileT':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨true,s⇩₁⟩; P,E ⊢ ⟨c,s⇩₁⟩ ⇒' ⟨Val v⇩₁,s⇩₂⟩; 
     P,E ⊢ ⟨while (e) c,s⇩₂⟩ ⇒' ⟨e⇩₃,s⇩₃⟩ ⟧
  ⟹ P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒' ⟨e⇩₃,s⇩₃⟩"
by transfer(rule WhileT)

lemma WhileCondThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule WhileCondThrow)

lemma WhileBodyThrow':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨true,s⇩₁⟩; P,E ⊢ ⟨c,s⇩₁⟩ ⇒' ⟨throw e',s⇩₂⟩⟧
  ⟹ P,E ⊢ ⟨while (e) c,s⇩₀⟩ ⇒' ⟨throw e',s⇩₂⟩"
by transfer(rule WhileBodyThrow)

lemma Throw':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref r,s⇩₁⟩ ⟹
  P,E ⊢ ⟨throw e,s⇩₀⟩ ⇒' ⟨Throw r,s⇩₁⟩"
by transfer(rule eval_evals.Throw)

lemma ThrowNull':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹
  P,E ⊢ ⟨throw e,s⇩₀⟩ ⇒' ⟨THROW NullPointer,s⇩₁⟩"
by transfer(rule ThrowNull)

lemma ThrowThrow':
  "P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹
  P,E ⊢ ⟨throw e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩"
by transfer(rule ThrowThrow)

lemma Nil':
  "P,E ⊢ ⟨[],s⟩ [⇒'] ⟨[],s⟩"
by transfer(rule eval_evals.Nil)

lemma Cons':
  "⟦ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨Val v,s⇩₁⟩; P,E ⊢ ⟨es,s⇩₁⟩ [⇒'] ⟨es',s⇩₂⟩ ⟧
  ⟹ P,E ⊢ ⟨e#es,s⇩₀⟩ [⇒'] ⟨Val v # es',s⇩₂⟩"
by transfer(rule eval_evals.Cons)

lemma ConsThrow':
  "P,E ⊢ ⟨e, s⇩₀⟩ ⇒' ⟨throw e', s⇩₁⟩ ⟹
  P,E ⊢ ⟨e#es, s⇩₀⟩ [⇒'] ⟨throw e' # es, s⇩₁⟩"
by transfer(rule ConsThrow)

text ‹Axiomatic heap address model refinement›

partial_function (option) lowest :: "(nat ⇒ bool) ⇒ nat ⇒ nat option"
where
  [code]: "lowest P n = (if P n then Some n else lowest P (Suc n))"

axiomatization
where
  new_Addr'_code [code]: "new_Addr' h = lowest (Option.is_none ∘ h) 0"
    ― ‹admissible: a tightening of the specification of @{const new_Addr'}›

lemma eval'_cases
  [consumes 1,
   case_names New NewFail StaticUpCast StaticDownCast StaticCastNull StaticCastFail
    StaticCastThrow StaticUpDynCast StaticDownDynCast DynCast DynCastNull DynCastFail
    DynCastThrow Val BinOp BinOpThrow1 BinOpThrow2 Var LAss LAssThrow FAcc FAccNull FAccThrow
    FAss FAssNull FAssThrow1 FAssThrow2 CallObjThrow CallParamsThrow Call StaticCall CallNull
    Block Seq SeqThrow CondT CondF CondThrow WhileF WhileT WhileCondThrow WhileBodyThrow
    Throw ThrowNull ThrowThrow]:
  assumes "P,x ⊢ ⟨y,z⟩ ⇒' ⟨u,v⟩"
  and "⋀h a h' C E l. x = E ⟹ y = new C ⟹ z = (h, l) ⟹ u = ref (a, [C]) ⟹
    v = (h', l) ⟹ new_Addr' h = ⌊a⌋ ⟹ h' = h(a ↦ blank' P C) ⟹ thesis"
  and "⋀h E C l. x = E ⟹ y = new C ⟹ z = (h, l) ⟹
    u = Throw (addr_of_sys_xcpt OutOfMemory, [OutOfMemory]) ⟹
    v = (h, l) ⟹ new_Addr' h = None ⟹ thesis"
  and "⋀E e s⇩₀ a Cs s⇩₁ C Cs' Ds. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩₀ ⟹
    u = ref (a, Ds) ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),s⇩₁⟩ ⟹
    P ⊢ Path last Cs to C via Cs'  ⟹ Ds = Cs @⇩_p Cs' ⟹ thesis"
  and "⋀E e s⇩₀ a Cs C Cs' s⇩₁. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩₀ ⟹ u = ref (a, Cs @ [C]) ⟹
    v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs @ [C] @ Cs'),s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ C. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩₀ ⟹ u = null ⟹ v = s⇩₁ ⟹
   P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ a Cs s⇩₁ C. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩₀ ⟹
    u = Throw (addr_of_sys_xcpt ClassCast, [ClassCast]) ⟹  v = s⇩₁ ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),s⇩₁⟩ ⟹ (last Cs, C) ∉ (subcls1 P)⇧^* ⟹ C ∉ set Cs ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁ C. x = E ⟹ y = ⦇C⦈e ⟹ z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ a Cs s⇩₁ C Cs' Ds. x = E ⟹ y = Cast C e ⟹ z = s⇩₀ ⟹ u = ref (a, Ds) ⟹
    v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),s⇩₁⟩ ⟹ P ⊢ Path last Cs to C unique ⟹
    P ⊢ Path last Cs to C via Cs'  ⟹ Ds = Cs @⇩_p Cs' ⟹ thesis"
  and "⋀E e s⇩₀ a Cs C Cs' s⇩₁. x = E ⟹ y = Cast C e ⟹ z = s⇩₀ ⟹
    u = ref (a, Cs @ [C]) ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs @ [C] @ Cs'),s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ a Cs h l D S C Cs'. x = E ⟹ y = Cast C e ⟹ z = s⇩₀ ⟹
    u = ref (a, Cs') ⟹ v = (h, l) ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),(h, l)⟩ ⟹
    h a = ⌊(D, S)⌋ ⟹ P ⊢ Path D to C via Cs'  ⟹ P ⊢ Path D to C unique ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ C. x = E ⟹ y = Cast C e ⟹ z = s⇩₀ ⟹ u = null ⟹ v = s⇩₁ ⟹ 
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹ thesis" 
  and "⋀E e s⇩₀ a Cs h l D S C. x = E ⟹ y = Cast C e ⟹ z = s⇩₀ ⟹ u = null ⟹
    v = (h, l) ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),(h, l)⟩ ⟹ h a = ⌊(D, S)⌋ ⟹
    ¬ P ⊢ Path D to C unique ⟹ ¬ P ⊢ Path last Cs to C unique ⟹ C ∉ set Cs ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁ C. x = E ⟹ y = Cast C e ⟹ z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁
    ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E va s. x = E ⟹ y = Val va ⟹ z = s ⟹ u = Val va ⟹ v = s ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ v⇩₁ s⇩₁ e⇩₂ v⇩₂ s⇩₂ bop va. x = E ⟹ y = e⇩₁ «bop» e⇩₂ ⟹ z = s⇩₀ ⟹
    u = Val va ⟹ v = s⇩₂ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨Val v⇩₁,s⇩₁⟩ ⟹
    P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨Val v⇩₂,s⇩₂⟩ ⟹ binop (bop, v⇩₁, v⇩₂) = ⌊va⌋ ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ e s⇩₁ bop e⇩₂. x = E ⟹ y = e⇩₁ «bop» e⇩₂ ⟹ z = s⇩₀ ⟹ u = throw e ⟹ v = s⇩₁  ⟹
    P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨throw e,s⇩₁⟩ ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ v⇩₁ s⇩₁ e⇩₂ e s⇩₂ bop. x = E ⟹ y = e⇩₁ «bop» e⇩₂ ⟹ z = s⇩₀ ⟹ u = throw e ⟹
    v = s⇩₂ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨Val v⇩₁,s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨throw e,s⇩₂⟩ ⟹ thesis"
  and "⋀l V va E h. x = E ⟹ y = Var V ⟹ z = (h, l) ⟹ u = Val va ⟹ v = (h, l) ⟹
    l V = ⌊va⌋ ⟹ thesis"
  and "⋀E e s⇩₀ va h l V T v' l'. x = E ⟹ y = V:=e ⟹ z = s⇩₀ ⟹ u = Val v' ⟹
    v = (h, l') ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨Val va,(h, l)⟩ ⟹
    E V = ⌊T⌋ ⟹ P ⊢ T casts va to v'  ⟹ l' = l(V ↦ v') ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁ V. x = E ⟹ y = V:=e ⟹ z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ a Cs' h l D S Ds Cs fs F va. x = E ⟹ y = e∙F{Cs} ⟹ z = s⇩₀ ⟹
    u = Val va ⟹ v = (h, l) ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs'),(h, l)⟩ ⟹
    h a = ⌊(D, S)⌋ ⟹ Ds = Cs' @⇩_p Cs ⟹ (Ds, fs) ∈ S ⟹ Mapping.lookup fs F = ⌊va⌋ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ F Cs. x = E ⟹ y = e∙F{Cs} ⟹ z = s⇩₀ ⟹
    u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
    v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁ F Cs. x = E ⟹ y = e∙F{Cs} ⟹ z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ a Cs' s⇩₁ e⇩₂ va h⇩₂ l⇩₂ D S F T Cs v' Ds fs fs' S' h⇩₂'.
    x = E ⟹ y = e⇩₁∙F{Cs} := e⇩₂ ⟹ z = s⇩₀ ⟹ u = Val v' ⟹ v = (h⇩₂', l⇩₂) ⟹
    P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨ref (a, Cs'),s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨Val va,(h⇩₂, l⇩₂)⟩ ⟹
    h⇩₂ a = ⌊(D, S)⌋ ⟹ P ⊢ last Cs' has least F:T via Cs ⟹
    P ⊢ T casts va to v'  ⟹ Ds = Cs' @⇩_p Cs ⟹ (Ds, fs) ∈ S ⟹ fs' = Mapping.update F v' fs ⟹
    S' = S - {(Ds, fs)} ∪ {(Ds, fs')} ⟹ h⇩₂' = h⇩₂(a ↦ (D, S')) ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ s⇩₁ e⇩₂ va s⇩₂ F Cs. x = E ⟹ y = e⇩₁∙F{Cs} := e⇩₂ ⟹ z = s⇩₀ ⟹
    u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
    v = s⇩₂ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨Val va,s⇩₂⟩ ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ e' s⇩₁ F Cs e⇩₂. x = E ⟹ y = e⇩₁∙F{Cs} := e⇩₂ ⟹
    z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e⇩₁ s⇩₀ va s⇩₁ e⇩₂ e' s⇩₂ F Cs. x = E ⟹ y = e⇩₁∙F{Cs} := e⇩₂ ⟹ z = s⇩₀ ⟹
    u = throw e' ⟹ v = s⇩₂ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₀⟩ ⇒' ⟨Val va,s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨throw e',s⇩₂⟩ ⟹ 
    thesis"
  and "⋀E e s⇩₀ e' s⇩₁ Copt M es. x = E ⟹ y = Call e Copt M es ⟹
    z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ va s⇩₁ es vs ex es' s⇩₂ Copt M. x = E ⟹ y = Call e Copt M es ⟹
    z = s⇩₀ ⟹ u = throw ex ⟹ v = s⇩₂ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨Val va,s⇩₁⟩ ⟹
    P,E ⊢ ⟨es,s⇩₁⟩ [⇒'] ⟨map Val vs @ throw ex # es',s⇩₂⟩ ⟹ thesis"
  and "⋀E e s⇩₀ a Cs s⇩₁ ps vs h⇩₂ l⇩₂ C S M Ts' T' pns' body' Ds Ts T pns body Cs' vs' l⇩₂' new_body e'
    h⇩₃ l⇩₃. x = E ⟹ y = Call e None M ps ⟹ z = s⇩₀ ⟹ u = e' ⟹ v = (h⇩₃, l⇩₂) ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),s⇩₁⟩ ⟹ P,E ⊢ ⟨ps,s⇩₁⟩ [⇒'] ⟨map Val vs,(h⇩₂, l⇩₂)⟩ ⟹
    h⇩₂ a = ⌊(C, S)⌋ ⟹ P ⊢ last Cs has least M = (Ts', T', pns', body') via Ds ⟹
    P ⊢ (C,Cs @⇩_p Ds) selects M = (Ts, T, pns, body) via Cs' ⟹ length vs = length pns ⟹
    P ⊢ Ts Casts vs to vs'  ⟹ l⇩₂' = [this ↦ Ref (a, Cs'), pns [↦] vs'] ⟹
    new_body = (case T' of Class D ⇒ ⦇D⦈body | _ ⇒ body) ⟹
    P,E(this ↦ Class (last Cs'), pns [↦] Ts) ⊢ ⟨new_body,(h⇩₂, l⇩₂')⟩ ⇒' ⟨e',(h⇩₃, l⇩₃)⟩ ⟹
    thesis"
  and "⋀E e s⇩₀ a Cs s⇩₁ ps vs h⇩₂ l⇩₂ C Cs'' M Ts T pns body Cs' Ds vs' l⇩₂' e' h⇩₃ l⇩₃.
    x = E ⟹ y = Call e ⌊C⌋ M ps ⟹ z = s⇩₀ ⟹ u = e' ⟹ v = (h⇩₃, l⇩₂) ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref (a, Cs),s⇩₁⟩ ⟹ P,E ⊢ ⟨ps,s⇩₁⟩ [⇒'] ⟨map Val vs,(h⇩₂, l⇩₂)⟩ ⟹
    P ⊢ Path last Cs to C unique ⟹ P ⊢ Path last Cs to C via Cs''  ⟹
    P ⊢ C has least M = (Ts, T, pns, body) via Cs' ⟹ Ds = (Cs @⇩_p Cs'') @⇩_p Cs' ⟹
    length vs = length pns ⟹ P ⊢ Ts Casts vs to vs'  ⟹
    l⇩₂' = [this ↦ Ref (a, Ds), pns [↦] vs'] ⟹
    P,E(this ↦ Class (last Ds), pns [↦] Ts) ⊢ ⟨body,(h⇩₂, l⇩₂')⟩ ⇒' ⟨e',(h⇩₃, l⇩₃)⟩ ⟹
    thesis"
  and "⋀E e s⇩₀ s⇩₁ es vs s⇩₂ Copt M. x = E ⟹ y = Call e Copt M es ⟹ z = s⇩₀ ⟹
    u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
    v = s⇩₂ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹ P,E ⊢ ⟨es,s⇩₁⟩ [⇒'] ⟨map Val vs,s⇩₂⟩ ⟹ thesis"
  and "⋀E V T e⇩₀ h⇩₀ l⇩₀ e⇩₁ h⇩₁ l⇩₁.
    x = E ⟹ y = {V:T; e⇩₀} ⟹ z = (h⇩₀, l⇩₀) ⟹ u = e⇩₁ ⟹
    v = (h⇩₁, l⇩₁(V := l⇩₀ V)) ⟹ P,E(V ↦ T) ⊢ ⟨e⇩₀,(h⇩₀, l⇩₀(V := None))⟩ ⇒' ⟨e⇩₁,(h⇩₁, l⇩₁)⟩ ⟹ thesis"
  and "⋀E e⇩₀ s⇩₀ va s⇩₁ e⇩₁ e⇩₂ s⇩₂. x = E ⟹ y = e⇩₀;; e⇩₁ ⟹ z = s⇩₀ ⟹ u = e⇩₂ ⟹
    v = s⇩₂ ⟹ P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒' ⟨Val va,s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₁⟩ ⇒' ⟨e⇩₂,s⇩₂⟩ ⟹ thesis"
  and "⋀E e⇩₀ s⇩₀ e s⇩₁ e⇩₁. x = E ⟹ y = e⇩₀;; e⇩₁ ⟹ z = s⇩₀ ⟹ u = throw e ⟹ v = s⇩₁ ⟹
    P,E ⊢ ⟨e⇩₀,s⇩₀⟩ ⇒' ⟨throw e,s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ e⇩₁ e' s⇩₂ e⇩₂. x = E ⟹ y = if (e) e⇩₁ else e⇩₂ ⟹ z = s⇩₀ ⟹ u = e' ⟹
    v = s⇩₂ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨true,s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₁,s⇩₁⟩ ⇒' ⟨e',s⇩₂⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ e⇩₂ e' s⇩₂ e⇩₁. x = E ⟹ y = if (e) e⇩₁ else e⇩₂ ⟹ z = s⇩₀ ⟹
    u = e' ⟹ v = s⇩₂ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨false,s⇩₁⟩ ⟹ P,E ⊢ ⟨e⇩₂,s⇩₁⟩ ⇒' ⟨e',s⇩₂⟩ ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁ e⇩₁ e⇩₂. x = E ⟹ y = if (e) e⇩₁ else e⇩₂ ⟹
    z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ c. x = E ⟹ y = while (e) c ⟹ z = s⇩₀ ⟹ u = unit ⟹ v = s⇩₁ ⟹
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨false,s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ c v⇩₁ s⇩₂ e⇩₃ s⇩₃. x = E ⟹ y = while (e) c ⟹ z = s⇩₀ ⟹ u = e⇩₃ ⟹
    v = s⇩₃ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨true,s⇩₁⟩ ⟹ P,E ⊢ ⟨c,s⇩₁⟩ ⇒' ⟨Val v⇩₁,s⇩₂⟩ ⟹
    P,E ⊢ ⟨while (e) c,s⇩₂⟩ ⇒' ⟨e⇩₃,s⇩₃⟩ ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁ c. x = E ⟹ y = while (e) c ⟹ z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹ 
    P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁ c e' s⇩₂. x = E ⟹ y = while (e) c ⟹ z = s⇩₀ ⟹ u = throw e' ⟹
    v = s⇩₂ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨true,s⇩₁⟩ ⟹ P,E ⊢ ⟨c,s⇩₁⟩ ⇒' ⟨throw e',s⇩₂⟩ ⟹ thesis"
  and "⋀E e s⇩₀ r s⇩₁. x = E ⟹ y = throw e ⟹
    z = s⇩₀ ⟹ u = Throw r ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨ref r,s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ s⇩₁. x = E ⟹ y = throw e ⟹ z = s⇩₀ ⟹
    u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) ⟹
    v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨null,s⇩₁⟩ ⟹ thesis"
  and "⋀E e s⇩₀ e' s⇩₁. x = E ⟹ y = throw e ⟹
    z = s⇩₀ ⟹ u = throw e' ⟹ v = s⇩₁ ⟹ P,E ⊢ ⟨e,s⇩₀⟩ ⇒' ⟨throw e',s⇩₁⟩ ⟹ thesis"
  shows thesis
using assms
by(transfer)(erule eval.cases, unfold blank_def, assumption+)

lemmas [code_pred_intro] = New' NewFail' StaticUpCast'
declare StaticDownCast'_new[code_pred_intro StaticDownCast']
lemmas [code_pred_intro] = StaticCastNull'
declare StaticCastFail'_new[code_pred_intro StaticCastFail']
lemmas [code_pred_intro] = StaticCastThrow' StaticUpDynCast'
declare
  StaticDownDynCast'_new[code_pred_intro StaticDownDynCast']
  DynCast'[code_pred_intro DynCast']
lemmas [code_pred_intro] = DynCastNull'
declare DynCastFail'[code_pred_intro DynCastFail']
lemmas [code_pred_intro] = DynCastThrow' Val' BinOp' BinOpThrow1'
declare BinOpThrow2'[code_pred_intro BinOpThrow2']
lemmas [code_pred_intro] = Var' LAss' LAssThrow'
declare FAcc'_new[code_pred_intro FAcc']
lemmas [code_pred_intro] = FAccNull' FAccThrow'
declare FAss'_new[code_pred_intro FAss']
lemmas [code_pred_intro] = FAssNull' FAssThrow1'
declare FAssThrow2'[code_pred_intro FAssThrow2']
lemmas [code_pred_intro] = CallObjThrow'
declare
  CallParamsThrow'_new[code_pred_intro CallParamsThrow']
  Call'_new[code_pred_intro Call']
  StaticCall'_new[code_pred_intro StaticCall']
  CallNull'_new[code_pred_intro CallNull']
lemmas [code_pred_intro] = Block' Seq'
declare SeqThrow'[code_pred_intro SeqThrow']
lemmas [code_pred_intro] = CondT'
declare 
  CondF'[code_pred_intro CondF']
  CondThrow'[code_pred_intro CondThrow']
lemmas [code_pred_intro] = WhileF' WhileT'
declare
  WhileCondThrow'[code_pred_intro WhileCondThrow']
  WhileBodyThrow'[code_pred_intro WhileBodyThrow']
lemmas [code_pred_intro] = Throw'
declare ThrowNull'[code_pred_intro ThrowNull']
lemmas [code_pred_intro] = ThrowThrow'
lemmas [code_pred_intro] = Nil' Cons' ConsThrow'

code_pred 
  (modes: eval': i ⇒ i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool as big_step
   and evals': i ⇒ i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool as big_steps)
  eval'
proof -
  case eval'
  from eval'.prems show thesis
  proof(cases (no_simp) rule: eval'_cases)
    case (StaticDownCast E C e s⇩₀ a Cs Cs' s⇩₁)
    moreover
    have "app a [Cs] (a @ [Cs])" "app (a @ [Cs]) Cs' (a @ [Cs] @ Cs')"
      by(simp_all add: app_eq)
    ultimately show ?thesis by(rule eval'.StaticDownCast'[OF refl])
  next
    case StaticCastFail thus ?thesis
      unfolding rtrancl_def subcls1_def mem_Collect_eq prod.case
      by(rule eval'.StaticCastFail'[OF refl])
  next
    case (StaticDownDynCast E e s⇩₀ a Cs C Cs' s⇩₁)
    moreover have "app Cs [C] (Cs @ [C])" "app (Cs @ [C]) Cs' (Cs @ [C] @ Cs')"
      by(simp_all add: app_eq)
    ultimately show thesis by(rule eval'.StaticDownDynCast'[OF refl])
  next
    case DynCast thus ?thesis by(rule eval'.DynCast'[OF refl])
  next
    case DynCastFail thus ?thesis by(rule eval'.DynCastFail'[OF refl])
  next
    case BinOpThrow2 thus ?thesis by(rule eval'.BinOpThrow2'[OF refl])
  next
    case FAcc thus ?thesis
      by(rule eval'.FAcc'[OF refl, unfolded Predicate_Compile.contains_def Set_project_def mem_Collect_eq])
  next
    case FAss thus ?thesis
      by(rule eval'.FAss'[OF refl, unfolded Predicate_Compile.contains_def Set_project_def mem_Collect_eq])
  next
    case FAssThrow2 thus ?thesis by(rule eval'.FAssThrow2'[OF refl])
  next
    case (CallParamsThrow E e s⇩₀ v s⇩₁ es vs ex es' s⇩₂ Copt M)
    moreover have "map_val2 (map Val vs @ throw ex # es') vs (throw ex # es')"
      by(simp add: map_val2_conv[symmetric])
    ultimately show ?thesis by(rule eval'.CallParamsThrow'[OF refl])
  next
    case (Call E e s⇩₀ a Cs s⇩₁ ps vs)
    moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
    ultimately show ?thesis by-(rule eval'.Call'[OF refl])
  next
    case (StaticCall E e s⇩₀ a Cs s⇩₁ ps vs)
    moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
    ultimately show ?thesis by-(rule eval'.StaticCall'[OF refl])
  next
    case (CallNull E e s⇩₀ s⇩₁ es vs)
    moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
    ultimately show ?thesis by-(rule eval'.CallNull'[OF refl])
  next
    case SeqThrow thus ?thesis by(rule eval'.SeqThrow'[OF refl])
  next
    case CondF thus ?thesis by(rule eval'.CondF'[OF refl])
  next
    case CondThrow thus ?thesis by(rule eval'.CondThrow'[OF refl])
  next
    case WhileCondThrow thus ?thesis by(rule eval'.WhileCondThrow'[OF refl])
  next
    case WhileBodyThrow thus ?thesis by(rule eval'.WhileBodyThrow'[OF refl])
  next
    case ThrowNull thus ?thesis by(rule eval'.ThrowNull'[OF refl])
  qed(assumption|erule (4) eval'.that[OF refl])+
next
  case evals'
  from evals'.prems evals'.that[OF refl]
  show thesis by transfer(erule evals.cases)
qed

subsection ‹Examples›

declare [[values_timeout = 180]]

values [expected "{Val (Intg 5)}"]
  "{fst (e', s') | e' s'. 
    [],Map.empty ⊢ ⟨{''V'':Integer; ''V'' :=  Val(Intg 5);; Var ''V''},(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val (Intg 11)}"]
  "{fst (e', s') | e' s'. 
    [],Map.empty ⊢ ⟨(Val(Intg 5)) «Add» (Val(Intg 6)),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val (Intg 83)}"]
  "{fst (e', s') | e' s'. 
    [],[''V''↦Integer] ⊢ ⟨(Var ''V'') «Add» (Val(Intg 6)),
                                       (Map.empty,[''V''↦Intg 77])⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Some (Intg 6)}"]
  "{lcl' (snd (e', s')) ''V''  | e' s'. 
    [],[''V''↦Integer] ⊢ ⟨''V'' := Val(Intg 6),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Some (Intg 12)}"]
  "{lcl' (snd (e', s')) ''mult''  | e' s'. 
    [],[''V''↦Integer,''a''↦Integer,''b''↦Integer,''mult''↦Integer]
    ⊢ ⟨(''a'' := Val(Intg 3));;(''b'' := Val(Intg 4));;(''mult'' := Val(Intg 0));;
       (''V'' := Val(Intg 1));;
       while (Var ''V'' «Eq» Val(Intg 1))((''mult'' := Var ''mult'' «Add» Var ''b'');;
         (''a'' := Var ''a'' «Add» Val(Intg (- 1)));;
         (''V'' := (if(Var ''a'' «Eq» Val(Intg 0)) Val(Intg 0) else Val(Intg 1)))),
       (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val (Intg 30)}"]
  "{fst (e', s') | e' s'. 
    [],[''a''↦Integer, ''b''↦Integer, ''c''↦ Integer, ''cond''↦Boolean]
    ⊢ ⟨''a'' := Val(Intg 17);; ''b'' := Val(Intg 13);; 
       ''c'' := Val(Intg 42);; ''cond'' := true;; 
       if (Var ''cond'') (Var ''a'' «Add» Var ''b'') else (Var ''a'' «Add» Var ''c''),
       (Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"


text ‹progOverrider examples›

definition
  classBottom :: "cdecl" where
  "classBottom = (''Bottom'', [Repeats ''Left'', Repeats ''Right''],
                   [(''x'',Integer)],[])" 

definition
  classLeft :: "cdecl" where
  "classLeft = (''Left'', [Repeats ''Top''],[],[(''f'', [Class ''Top'', Integer],Integer, [''V'',''W''],Var this ∙ ''x'' {[''Left'',''Top'']} «Add» Val (Intg 5))])"

definition
  classRight :: "cdecl" where
  "classRight = (''Right'', [Shares ''Right2''],[],
    [(''f'', [Class ''Top'', Integer], Integer,[''V'',''W''],Var this ∙ ''x'' {[''Right2'',''Top'']} «Add» Val (Intg 7)),(''g'',[],Class ''Left'',[],new ''Left'')])"

definition
  classRight2 :: "cdecl" where
  "classRight2 = (''Right2'', [Repeats ''Top''],[],
    [(''f'', [Class ''Top'', Integer], Integer,[''V'',''W''],Var this ∙ ''x'' {[''Right2'',''Top'']} «Add» Val (Intg 9)),(''g'',[],Class ''Top'',[],new ''Top'')])"

definition
  classTop :: "cdecl" where
  "classTop = (''Top'', [], [(''x'',Integer)],[])"

definition
  progOverrider :: "cdecl list" where
  "progOverrider = [classBottom, classLeft, classRight, classRight2, classTop]"

values [expected "{Val(Ref(0,[''Bottom'',''Left'']))}"] ― ‹dynCastSide›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right''] ⊢
    ⟨''V'' := new ''Bottom'' ;; Cast ''Left'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val(Ref(0,[''Right'']))}"] ― ‹dynCastViaSh›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right2''] ⊢ 
    ⟨''V'' := new ''Right'' ;; Cast ''Right'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val (Intg 42)}"] ― ‹block›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Integer] 
    ⊢ ⟨''V'' := Val(Intg 42) ;; {''V'':Class ''Left''; ''V'' := new ''Bottom''} ;; Var ''V'',
      (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val (Intg 8)}"] ― ‹staticCall›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right'',''W''↦Class ''Bottom''] 
    ⊢ ⟨''V'' := new ''Bottom'' ;; ''W'' := new ''Bottom'' ;; 
       ((Cast ''Left'' (Var ''W''))∙''x''{[''Left'',''Top'']} := Val(Intg 3));;
       (Var ''W''∙(''Left''::)''f''([Var ''V'',Val(Intg 2)])),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val (Intg 12)}"] ― ‹call›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right2'',''W''↦Class ''Left''] 
    ⊢ ⟨''V'' := new ''Right'' ;; ''W'' := new ''Left'' ;; 
       (Var ''V''∙''f''([Var ''W'',Val(Intg 42)])) «Add» (Var ''W''∙''f''([Var ''V'',Val(Intg 13)])),
       (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val(Intg 13)}"] ― ‹callOverrider›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right2'',''W''↦Class ''Left''] 
    ⊢ ⟨''V'' := new ''Bottom'';; (Var ''V'' ∙ ''x'' {[''Right2'',''Top'']} := Val(Intg 6));; 
       ''W'' := new ''Left'' ;; Var ''V''∙''f''([Var ''W'',Val(Intg 42)]),
       (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val(Ref(1,[''Left'',''Top'']))}"] ― ‹callClass›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right2''] 
    ⊢ ⟨''V'' := new ''Right'' ;; Var ''V''∙''g''([]),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val(Intg 42)}"] ― ‹fieldAss›
  "{fst (e', s') | e' s'. 
    progOverrider,[''V''↦Class ''Right2''] 
    ⊢ ⟨''V'' := new ''Right'' ;; 
       (Var ''V''∙''x''{[''Right2'',''Top'']} := (Val(Intg 42))) ;; 
       (Var ''V''∙''x''{[''Right2'',''Top'']}),(Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"


text ‹typing rules›

values [expected "{Class ''Bottom''}"] ― ‹typeNew›
  "{T. progOverrider,Map.empty ⊢ new ''Bottom'' :: T}"

values [expected "{Class ''Left''}"] ― ‹typeDynCast›
  "{T. progOverrider,Map.empty ⊢ Cast ''Left'' (new ''Bottom'') :: T}"

values [expected "{Class ''Left''}"] ― ‹typeStaticCast›
  "{T. progOverrider,Map.empty ⊢ ⦇''Left''⦈ (new ''Bottom'') :: T}"

values [expected "{Integer}"] ― ‹typeVal›
  "{T. [],Map.empty ⊢ Val(Intg 17) :: T}"

values [expected "{Integer}"] ― ‹typeVar›
  "{T. [],[''V'' ↦ Integer] ⊢ Var ''V'' :: T}"

values [expected "{Boolean}"] ― ‹typeBinOp›
  "{T. [],Map.empty ⊢ (Val(Intg 5)) «Eq» (Val(Intg 6)) :: T}"

values [expected "{Class ''Top''}"] ― ‹typeLAss›
  "{T. progOverrider,[''V'' ↦ Class ''Top''] ⊢ ''V'' := (new ''Left'') :: T}"

values [expected "{Integer}"] ― ‹typeFAcc›
  "{T. progOverrider,Map.empty ⊢ (new ''Right'')∙''x''{[''Right2'',''Top'']} :: T}"

values [expected "{Integer}"] ― ‹typeFAss›
  "{T. progOverrider,Map.empty ⊢ (new ''Right'')∙''x''{[''Right2'',''Top'']} :: T}"

values [expected "{Integer}"] ― ‹typeStaticCall›
  "{T. progOverrider,[''V''↦Class ''Left''] 
       ⊢ ''V'' := new ''Left'' ;; Var ''V''∙(''Left''::)''f''([new ''Top'', Val(Intg 13)]) :: T}"

values [expected "{Class ''Top''}"] ― ‹typeCall›
  "{T. progOverrider,[''V''↦Class ''Right2''] 
       ⊢ ''V'' := new ''Right'' ;; Var ''V''∙''g''([]) :: T}"

values [expected "{Class ''Top''}"] ― ‹typeBlock›
  "{T. progOverrider,Map.empty ⊢ {''V'':Class ''Top''; ''V'' := new ''Left''} :: T}"

values [expected "{Integer}"] ― ‹typeCond›
  "{T. [],Map.empty ⊢ if (true) Val(Intg 6) else Val(Intg 9) :: T}"

values [expected "{Void}"] ― ‹typeWhile›
  "{T. [],Map.empty ⊢ while (false) Val(Intg 17) :: T}"

values [expected "{Void}"] ― ‹typeThrow›
  "{T. progOverrider,Map.empty ⊢ throw (new ''Bottom'') :: T}"

values [expected "{Integer}"] ― ‹typeBig›
  "{T. progOverrider,[''V''↦Class ''Right2'',''W''↦Class ''Left''] 
       ⊢ ''V'' := new ''Right'' ;; ''W'' := new ''Left'' ;; 
         (Var ''V''∙''f''([Var ''W'', Val(Intg 7)])) «Add» (Var ''W''∙''f''([Var ''V'', Val(Intg 13)])) 
       :: T}"


text ‹progDiamond examples›

definition
  classDiamondBottom :: "cdecl" where
  "classDiamondBottom = (''Bottom'', [Repeats ''Left'', Repeats ''Right''],[(''x'',Integer)],
    [(''g'', [],Integer, [],Var this ∙ ''x'' {[''Bottom'']} «Add» Val (Intg 5))])" 

definition
  classDiamondLeft :: "cdecl" where
  "classDiamondLeft = (''Left'', [Repeats ''TopRep'',Shares ''TopSh''],[],[])"

definition
  classDiamondRight :: "cdecl" where
  "classDiamondRight = (''Right'', [Repeats ''TopRep'',Shares ''TopSh''],[],
    [(''f'', [Integer], Boolean,[''i''], Var ''i'' «Eq» Val (Intg 7))])"

definition
  classDiamondTopRep :: "cdecl" where
  "classDiamondTopRep = (''TopRep'', [], [(''x'',Integer)],
    [(''g'', [],Integer, [], Var this ∙ ''x'' {[''TopRep'']} «Add» Val (Intg 10))])"

definition
  classDiamondTopSh :: "cdecl" where
  "classDiamondTopSh = (''TopSh'', [], [], 
    [(''f'', [Integer], Boolean,[''i''], Var ''i'' «Eq» Val (Intg 3))])"

definition
  progDiamond :: "cdecl list" where
  "progDiamond = [classDiamondBottom, classDiamondLeft, classDiamondRight, classDiamondTopRep, classDiamondTopSh]"

values [expected "{Val(Ref(0,[''Bottom'',''Left'']))}"] ― ‹cast1›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''Left''] ⊢ ⟨''V'' := new ''Bottom'',
                                                      (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val(Ref(0,[''TopSh'']))}"] ― ‹cast2›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''TopSh''] ⊢ ⟨''V'' := new ''Bottom'',
                                                      (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{}"] ― ‹typeCast3 not typeable›
  "{T. progDiamond,[''V''↦Class ''TopRep''] ⊢ ''V'' := new ''Bottom'' :: T}"

values [expected "{
   Val(Ref(0,[''Bottom'', ''Left'', ''TopRep''])), 
   Val(Ref(0,[''Bottom'', ''Right'', ''TopRep'']))
  }"] ― ‹cast3›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''TopRep''] ⊢ ⟨''V'' := new ''Bottom'', 
                                                      (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

values [expected "{Val(Intg 17)}"] ― ‹fieldAss›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''Bottom''] 
    ⊢ ⟨''V'' := new ''Bottom'' ;; 
       ((Var ''V'')∙''x''{[''Bottom'']} := (Val(Intg 17))) ;; 
       ((Var ''V'')∙''x''{[''Bottom'']}),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"

values [expected "{Val Null}"] ― ‹dynCastNull›
  "{fst (e', s') | e' s'. 
    progDiamond,Map.empty ⊢ ⟨Cast ''Right'' null,(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"

values [expected "{Val (Ref(0, [''Right'']))}"] ― ‹dynCastViaSh›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''TopSh''] 
    ⊢ ⟨''V'' := new ''Right'' ;; Cast ''Right'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"

values [expected "{Val Null}"] ― ‹dynCastFail›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''TopRep''] 
    ⊢ ⟨''V'' := new ''Right'' ;; Cast ''Bottom'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"

values [expected "{Val (Ref(0, [''Bottom'', ''Left'']))}"] ― ‹dynCastSide›
  "{fst (e', s') | e' s'. 
    progDiamond,[''V''↦Class ''Right'']
    ⊢ ⟨''V'' := new ''Bottom'' ;; Cast ''Left'' (Var ''V''),(Map.empty,Map.empty)⟩ ⇒' ⟨e',s'⟩}"

text ‹failing g++ example›

definition
  classD :: "cdecl" where
  "classD = (''D'', [Shares ''A'', Shares ''B'', Repeats ''C''],[],[])"

definition
  classC :: "cdecl" where
  "classC = (''C'', [Shares ''A'', Shares ''B''],[],
              [(''f'',[],Integer,[],Val(Intg 42))])"

definition
  classB :: "cdecl" where
  "classB = (''B'', [],[],
              [(''f'',[],Integer,[],Val(Intg 17))])"

definition
  classA :: "cdecl" where
  "classA = (''A'', [],[],
              [(''f'',[],Integer,[],Val(Intg 13))])"

definition
  ProgFailing :: "cdecl list" where
  "ProgFailing = [classA,classB,classC,classD]"

values [expected "{Val (Intg 42)}"] ― ‹callFailGplusplus›
  "{fst (e', s') | e' s'. 
    ProgFailing,Map.empty 
    ⊢ ⟨{''V'':Class ''D''; ''V'' := new ''D'';; Var ''V''∙''f''([])},
       (Map.empty,Map.empty)⟩ ⇒' ⟨e', s'⟩}"

end

Theory Auxiliary

Theory Type

Theory Value

Theory Expr

Theory Decl

Theory ClassRel

Theory SubObj

Theory Objects

Theory Exceptions

Theory Syntax

Theory State

Theory BigStep

Theory SmallStep

Theory SystemClasses

Theory TypeRel

Theory WellType

Theory WellForm

Theory WWellForm

Theory Equivalence

Theory DefAss

Theory WellTypeRT

Theory Conform

Theory Progress

Theory HeapExtension

Theory CWellForm

Theory TypeSafe

Theory Determinism

Theory Annotate

Theory Execute

Theory CoreC++